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 ;; Maintainers: D. Goel <deego@gnufans.org>
7 ;; Colin Walters <walters@debian.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY. No author or distributor
13 ;; accepts responsibility to anyone for the consequences of using it
14 ;; or for whether it serves any particular purpose or works at all,
15 ;; unless he says so in writing. Refer to the GNU Emacs General Public
16 ;; License for full details.
18 ;; Everyone is granted permission to copy, modify and redistribute
19 ;; GNU Emacs, but only under the conditions described in the
20 ;; GNU Emacs General Public License. A copy of this license is
21 ;; supposed to have been given to you along with GNU Emacs so you
22 ;; can know your rights and responsibilities. It should be in a
23 ;; file named COPYING. Among other things, the copyright notice
24 ;; and this notice must be preserved on all copies.
30 ;; This file is autoloaded from calc-ext.el.
35 (defun calc-Need-calc-stuff () nil
)
38 (defun calc-num-prefix (n)
39 "Use the number at the top of stack as the numeric prefix for the next command.
40 With a prefix, push that prefix as a number onto the stack."
44 (calc-enter-result 0 "" (prefix-numeric-value n
))
45 (let ((num (calc-top 1)))
46 (if (math-messy-integerp num
)
47 (setq num
(math-trunc num
)))
49 (error "Argument must be a small integer"))
52 (message "%d-" num
))))) ; a (lame) simulation of the real thing...
55 (defun calc-more-recursion-depth (n)
59 (calc-less-recursion-depth n
)
60 (let ((n (if n
(prefix-numeric-value n
) 2)))
62 (setq max-specpdl-size
(* max-specpdl-size n
)
63 max-lisp-eval-depth
(* max-lisp-eval-depth n
))))
64 (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth
))))
66 (defun calc-less-recursion-depth (n)
68 (let ((n (if n
(prefix-numeric-value n
) 2)))
70 (setq max-specpdl-size
71 (max (/ max-specpdl-size n
) 600)
73 (max (/ max-lisp-eval-depth n
) 200))))
74 (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth
))
77 (defvar calc-which-why nil
)
78 (defvar calc-last-why-command nil
)
79 (defun calc-explain-why (why &optional more
)
82 (let* ((pred (car why
))
84 (msg (cond ((not pred
) "Wrong type of argument")
86 ((eq pred
'integerp
) "Integer expected")
88 (if (and arg
(Math-objvecp arg
) (not (Math-integerp arg
)))
90 "Nonnegative integer expected"))
92 (if (and arg
(Math-objvecp arg
) (not (Math-integerp arg
)))
94 "Positive integer expected"))
96 (if (and arg
(Math-integerp arg
))
97 "Small integer expected"
99 ((eq pred
'fixnatnump
)
100 (if (and arg
(Math-natnump arg
))
101 "Small integer expected"
102 (if (and arg
(Math-objvecp arg
)
103 (not (Math-integerp arg
)))
105 "Nonnegative integer expected")))
106 ((eq pred
'fixposintp
)
107 (if (and arg
(Math-integerp arg
) (Math-posp arg
))
108 "Small integer expected"
109 (if (and arg
(Math-objvecp arg
)
110 (not (Math-integerp arg
)))
112 "Positive integer expected")))
113 ((eq pred
'posp
) "Positive number expected")
114 ((eq pred
'negp
) "Negative number expected")
115 ((eq pred
'nonzerop
) "Nonzero number expected")
116 ((eq pred
'realp
) "Real number expected")
117 ((eq pred
'anglep
) "Real number expected")
118 ((eq pred
'hmsp
) "HMS form expected")
120 (if (and arg
(Math-objectp arg
)
121 (not (Math-realp arg
)))
122 "Real number or date form expected"
123 "Date form expected"))
124 ((eq pred
'numberp
) "Number expected")
125 ((eq pred
'scalarp
) "Number expected")
126 ((eq pred
'vectorp
) "Vector or matrix expected")
127 ((eq pred
'numvecp
) "Number or vector expected")
128 ((eq pred
'matrixp
) "Matrix expected")
129 ((eq pred
'square-matrixp
)
130 (if (and arg
(math-matrixp arg
))
131 "Square matrix expected"
133 ((eq pred
'objectp
) "Number expected")
134 ((eq pred
'constp
) "Constant expected")
135 ((eq pred
'range
) "Argument out of range")
136 (t (format "%s expected" pred
))))
138 (calc-can-abbrev-vectors t
))
139 (while (setq why
(cdr why
))
141 (setq msg
(concat msg punc
(if (stringp (car why
))
143 (math-format-flat-expr (car why
) 0)))
145 (message "%s%s" msg
(if more
" [w=more]" ""))))
149 (if (not (eq this-command last-command
))
150 (if (eq last-command calc-last-why-command
)
151 (setq calc-which-why
(cdr calc-why
))
152 (setq calc-which-why calc-why
)))
155 (calc-explain-why (car calc-which-why
) (cdr calc-which-why
))
156 (setq calc-which-why
(cdr calc-which-why
)))
159 (message "(No further explanations available)")
160 (setq calc-which-why calc-why
))
161 (message "No explanations available"))))
164 (defun calc-version ()
166 (message "Calc %s" calc-version
))
169 (defun calc-flush-caches (&optional inhibit-msg
)
172 (setq math-lud-cache nil
174 math-radix-digits-cache nil
175 math-radix-float-cache-tag nil
176 math-random-cache nil
177 math-max-digits-cache nil
178 math-checked-rewrites nil
179 math-integral-cache nil
181 math-decls-cache-tag nil
182 math-eval-rules-cache-tag t
183 math-graph-var-cache nil
184 math-graph-data-cache nil
185 math-format-date-cache nil
186 math-holidays-cache-tag t
)
187 (mapcar (function (lambda (x) (set x -
100))) math-cache-list
)
189 (message "All internal calculator caches have been reset"))))
194 (defun calc-clean (n)
197 (calc-with-default-simplification
198 (let ((func (if (calc-is-hyperbolic) 'calcFunc-clean
'calcFunc-pclean
)))
199 (calc-enter-result 1 "cln"
201 (let ((n (prefix-numeric-value n
)))
205 (+ n calc-internal-prec
)
207 (list func
(calc-top-n 1))))))))
209 (defun calc-clean-num (num)
211 (calc-clean (- (if num
212 (prefix-numeric-value num
)
213 (if (and (>= last-command-char ?
0)
214 (<= last-command-char ?
9))
215 (- last-command-char ?
0)
216 (error "Number required"))))))
219 (defvar math-chopping-small nil
)
220 (defun calcFunc-clean (a &optional prec
) ; [X X S] [Public]
222 (cond ((Math-messy-integerp prec
)
223 (calcFunc-clean a
(math-trunc prec
)))
224 ((or (not (integerp prec
))
226 (calc-record-why "*Precision must be an integer 3 or above")
227 (list 'calcFunc-clean a prec
))
228 ((not (Math-objvecp a
))
229 (list 'calcFunc-clean a prec
))
230 (t (let ((calc-internal-prec prec
)
231 (math-chopping-small t
))
232 (calcFunc-clean (math-normalize a
)))))
233 (cond ((eq (car-safe a
) 'polar
)
234 (let ((theta (math-mod (nth 2 a
)
235 (if (eq calc-angle-mode
'rad
)
242 (calcFunc-clean (nth 1 a
))
243 (calcFunc-clean theta
)))))))
244 ((memq (car-safe a
) '(vec date hms
))
245 (cons (car a
) (mapcar 'calcFunc-clean
(cdr a
))))
246 ((memq (car-safe a
) '(cplx mod sdev intv
))
247 (math-normalize (cons (car a
) (mapcar 'calcFunc-clean
(cdr a
)))))
248 ((eq (car-safe a
) 'float
)
249 (if math-chopping-small
250 (if (or (> (nth 2 a
) (- calc-internal-prec
))
251 (Math-lessp (- calc-internal-prec
) (calcFunc-xpon a
)))
252 (if (and (math-num-integerp a
)
253 (math-lessp (calcFunc-xpon a
) calc-internal-prec
))
259 ((math-infinitep a
) a
)
260 (t (list 'calcFunc-clean a
)))))
262 (defun calcFunc-pclean (a &optional prec
)
263 (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec
)))
266 (defun calcFunc-pfloat (a)
267 (math-map-over-constants 'math-float a
))
269 (defun calcFunc-pfrac (a &optional tol
)
270 (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol
)))
273 (defun math-map-over-constants (func expr
)
274 (math-map-over-constants-rec expr
))
276 (defun math-map-over-constants-rec (expr)
277 (cond ((or (Math-primp expr
)
278 (memq (car expr
) '(intv sdev
)))
279 (or (and (Math-objectp expr
)
282 ((and (memq (car expr
) '(^ calcFunc-subscr
))
283 (eq func
'math-float
)
285 (Math-integerp (nth 2 expr
)))
287 (math-map-over-constants-rec (nth 1 expr
))
289 (t (cons (car expr
) (mapcar 'math-map-over-constants-rec
(cdr expr
))))))
291 ;;; arch-tag: 789332ef-a178-49d3-8fb7-5d7ed7e21f56
292 ;;; calc-stuff.el ends here