diff options
Diffstat (limited to 'lisp/calc/calc-ext.el')
| -rw-r--r-- | lisp/calc/calc-ext.el | 170 |
1 files changed, 130 insertions, 40 deletions
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 8c52305a46b..5e5ae8166db 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -30,6 +30,51 @@ (require 'calc) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function math-clip "calc-bin" (a &optional w)) +(declare-function math-round "calc-arith" (a &optional prec)) +(declare-function math-simplify "calc-alg" (top-expr)) +(declare-function math-simplify-extended "calc-alg" (a)) +(declare-function math-simplify-units "calc-units" (a)) +(declare-function calc-set-language "calc-lang" (lang &optional option no-refresh)) +(declare-function calc-flush-caches "calc-stuff" (&optional inhibit-msg)) +(declare-function calc-save-modes "calc-mode" ()) +(declare-function calc-embedded-modes-change "calc-embed" (vars)) +(declare-function calc-embedded-var-change "calc-embed" (var &optional buf)) +(declare-function math-mul-float "calc-arith" (a b)) +(declare-function math-arctan-raw "calc-math" (x)) +(declare-function math-sqrt-raw "calc-math" (a &optional guess)) +(declare-function math-sqrt-float "calc-math" (a &optional guess)) +(declare-function math-exp-minus-1-raw "calc-math" (x)) +(declare-function math-normalize-polar "calc-cplx" (a)) +(declare-function math-normalize-hms "calc-forms" (a)) +(declare-function math-normalize-mod "calc-forms" (a)) +(declare-function math-make-sdev "calc-forms" (x sigma)) +(declare-function math-make-intv "calc-forms" (mask lo hi)) +(declare-function math-normalize-logical-op "calc-prog" (a)) +(declare-function math-possible-signs "calc-arith" (a &optional origin)) +(declare-function math-infinite-dir "calc-math" (a &optional inf)) +(declare-function math-calcFunc-to-var "calc-map" (f)) +(declare-function calc-embedded-evaluate-expr "calc-embed" (x)) +(declare-function math-known-nonzerop "calc-arith" (a)) +(declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term)) +(declare-function math-read-big-rec "calc-lang" (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 &optional baseline prec short)) +(declare-function math-read-big-balance "calc-lang" (h v what &optional commas)) +(declare-function math-format-date "calc-forms" (math-fd-date)) +(declare-function math-vector-is-string "calccomp" (a)) +(declare-function math-vector-to-string "calccomp" (a &optional quoted)) +(declare-function math-format-radix-float "calc-bin" (a prec)) +(declare-function math-compose-expr "calccomp" (a prec)) +(declare-function math-abs "calc-arith" (a)) +(declare-function math-format-bignum-binary "calc-bin" (a)) +(declare-function math-format-bignum-octal "calc-bin" (a)) +(declare-function math-format-bignum-hex "calc-bin" (a)) +(declare-function math-format-bignum-radix "calc-bin" (a)) +(declare-function math-compute-max-digits "calc-bin" (w r)) +(declare-function math-map-vec "calc-vec" (f a)) +(declare-function math-make-frac "calc-frac" (num den)) + + (defvar math-simplifying nil) (defvar math-living-dangerously nil) ; true if unsafe simplifications are okay. (defvar math-integrating nil) @@ -211,6 +256,7 @@ (define-key calc-mode-map "dt" 'calc-truncate-stack) (define-key calc-mode-map "dw" 'calc-auto-why) (define-key calc-mode-map "dz" 'calc-leading-zeros) + (define-key calc-mode-map "dA" 'calc-giac-language) (define-key calc-mode-map "dB" 'calc-big-language) (define-key calc-mode-map "dD" 'calc-redo) (define-key calc-mode-map "dC" 'calc-c-language) @@ -224,6 +270,8 @@ (define-key calc-mode-map "dL" 'calc-latex-language) (define-key calc-mode-map "dU" 'calc-unformatted-language) (define-key calc-mode-map "dW" 'calc-maple-language) + (define-key calc-mode-map "dX" 'calc-maxima-language) + (define-key calc-mode-map "dY" 'calc-yacas-language) (define-key calc-mode-map "d[" 'calc-truncate-up) (define-key calc-mode-map "d]" 'calc-truncate-down) (define-key calc-mode-map "d." 'calc-point-char) @@ -618,15 +666,15 @@ (calc-init-prefixes) - (mapcar (function - (lambda (x) - (define-key calc-mode-map (format "c%c" x) 'calc-clean-num) - (define-key calc-mode-map (format "j%c" x) 'calc-select-part) - (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick) - (define-key calc-mode-map (format "s%c" x) 'calc-store-quick) - (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick) - (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) - "0123456789") + (mapc (function + (lambda (x) + (define-key calc-mode-map (format "c%c" x) 'calc-clean-num) + (define-key calc-mode-map (format "j%c" x) 'calc-select-part) + (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick) + (define-key calc-mode-map (format "s%c" x) 'calc-store-quick) + (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick) + (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) + "0123456789") (let ((i ?A)) (while (<= i ?z) @@ -635,7 +683,7 @@ (cons 'keymap (cons (cons ?\e (aref (nth 1 calc-mode-map) i)) (cdr (aref (nth 1 calc-mode-map) i)))))) (setq i (1+ i)))) - + (setq calc-alg-map (copy-keymap calc-mode-map) calc-alg-esc-map (copy-keymap esc-map)) (let ((i 32)) @@ -651,7 +699,7 @@ (define-key calc-alg-map "\e\177" 'calc-pop-above) ;;;; (Autoloads here) - (mapcar (function (lambda (x) + (mapc (function (lambda (x) (mapcar (function (lambda (func) (autoload func (car x)))) (cdr x)))) '( @@ -1008,6 +1056,7 @@ calc-keypad-press) ("calc-lang" calc-big-language calc-c-language calc-eqn-language calc-flat-language calc-fortran-language calc-maple-language +calc-yacas-language calc-maxima-language calc-giac-language calc-mathematica-language calc-normal-language calc-pascal-language calc-tex-language calc-latex-language calc-unformatted-language) @@ -1021,7 +1070,7 @@ calc-arctan calc-arctan2 calc-arctanh calc-conj calc-cos calc-cosh calc-cot calc-coth calc-csc calc-csch calc-degrees-mode calc-exp calc-expm1 calc-hypot calc-ilog calc-imaginary calc-isqrt calc-ln calc-lnp1 calc-log calc-log10 -calc-pi calc-radians-mode calc-sec calc-sech +calc-pi calc-radians-mode calc-sec calc-sech calc-sin calc-sincos calc-sinh calc-sqrt calc-tan calc-tanh calc-to-degrees calc-to-radians) @@ -1277,7 +1326,7 @@ calc-kill calc-kill-region calc-yank)))) calc-redo-list nil) (let (calc-stack calc-user-parse-tables calc-standard-date-formats calc-invocation-macro) - (mapcar (function (lambda (v) (set v nil))) calc-local-var-list) + (mapc (function (lambda (v) (set v nil))) calc-local-var-list) (if (and arg (<= arg 0)) (calc-mode-var-list-restore-default-values) (calc-mode-var-list-restore-saved-values))) @@ -1357,7 +1406,7 @@ calc-kill calc-kill-region calc-yank)))) (with-current-buffer calc-main-buffer calc-hyperbolic-flag) calc-hyperbolic-flag)) - (msg (if hyp-flag + (msg (if hyp-flag "Inverse Hyperbolic..." "Inverse..."))) (calc-fancy-prefix 'calc-inverse-flag msg n))) @@ -1389,7 +1438,7 @@ calc-kill calc-kill-region calc-yank)))) (calc-set-command-flag 'no-align) (setq prefix (set flag (not (symbol-value flag))) prefix-arg n) - (message (if prefix msg ""))) + (message "%s" (if prefix msg ""))) (and prefix (not calc-is-keypad-press) (if (boundp 'overriding-terminal-local-map) @@ -1438,7 +1487,7 @@ calc-kill calc-kill-region calc-yank)))) (with-current-buffer calc-main-buffer calc-inverse-flag) calc-inverse-flag)) - (msg (if inv-flag + (msg (if inv-flag "Inverse Hyperbolic..." "Hyperbolic..."))) (calc-fancy-prefix 'calc-hyperbolic-flag msg n))) @@ -1782,8 +1831,8 @@ calc-kill calc-kill-region calc-yank)))) ;;; User menu. (defun calc-user-key-map () - (if calc-emacs-type-lucid - (error "User-defined keys are not supported in Lucid Emacs")) + (if (featurep 'xemacs) + (error "User-defined keys are not supported in XEmacs")) (let ((res (cdr (lookup-key calc-mode-map "z")))) (if (eq (car (car res)) 27) (cdr res) @@ -1849,7 +1898,7 @@ calc-kill calc-kill-region calc-yank)))) (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") desc)) (if (> (+ (length calc-z-prefix-buf) (length desc)) 58) - (setq calc-z-prefix-msgs + (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs) calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") desc)) @@ -1878,8 +1927,19 @@ calc-kill calc-kill-region calc-yank)))) (last-prec (intern (concat (symbol-name name) "-last-prec"))) (last-val (intern (concat (symbol-name name) "-last")))) (list 'progn - (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) - (list 'defvar cache-val (list 'quote init)) +; (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) + (list 'defvar cache-prec + `(cond + ((consp ,init) (math-numdigs (nth 1 ,init))) + (,init + (nth 1 (math-numdigs (eval ,init)))) + (t + -100))) + (list 'defvar cache-val + `(cond + ((consp ,init) ,init) + (,init (eval ,init)) + (t ,init))) (list 'defvar last-prec -100) (list 'defvar last-val nil) (list 'setq 'math-cache-list @@ -1914,7 +1974,11 @@ calc-kill calc-kill-region calc-yank)))) (put 'math-defcache 'lisp-indent-hook 2) ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] -(math-defcache math-pi (float (bigpos 463 238 793 589 653 592 141 3) -21) +(defconst math-approx-pi + (math-read-number-simple "3.141592653589793238463") + "An approximation for pi.") + +(math-defcache math-pi math-approx-pi (math-add-float (math-mul-float '(float 16 0) (math-arctan-raw '(float 2 -1))) (math-mul-float '(float -4 0) @@ -1945,7 +2009,11 @@ calc-kill calc-kill-region calc-yank)))) (math-defcache math-sqrt-two-pi nil (math-sqrt-float (math-two-pi))) -(math-defcache math-sqrt-e (float (bigpos 849 146 128 700 270 721 648 1) -21) +(defconst math-approx-sqrt-e + (math-read-number-simple "1.648721270700128146849") + "An approximation for sqrt(3).") + +(math-defcache math-sqrt-e math-approx-sqrt-e (math-add-float '(float 1 0) (math-exp-minus-1-raw '(float 5 -1)))) (math-defcache math-e nil @@ -1955,10 +2023,13 @@ calc-kill calc-kill-region calc-yank)))) (math-mul-float (math-add-float (math-sqrt-raw '(float 5 0)) '(float 1 0)) '(float 5 -1))) +(defconst math-approx-gamma-const + (math-read-number-simple + "0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495") + "An approximation for gamma.") + (math-defcache math-gamma-const nil - '(float (bigpos 495 467 917 632 470 369 709 646 776 267 677 848 348 672 - 057 988 235 399 359 593 421 310 024 824 900 120 065 606 - 328 015 649 156 772 5) -100)) + math-approx-gamma-const) (defun math-half-circle (symb) (if (eq calc-angle-mode 'rad) @@ -2068,7 +2139,7 @@ calc-kill calc-kill-region calc-yank)))) ;;; True if A is a real or will evaluate to a real. [P x] [Public] (defun math-provably-realp (a) (or (Math-realp a) - (math-provably-integer a) + (math-provably-integerp a) (memq (car-safe a) '(abs arg)))) ;;; True if A is a non-real, complex number. [P x] [Public] @@ -2126,12 +2197,12 @@ calc-kill calc-kill-region calc-yank)))) (unless a (setq a 1)) (and - (not (memq nil (mapcar + (not (memq nil (mapcar (lambda (x) (eq x 0)) (nthcdr (1+ n) row)))) - (not (memq nil (mapcar + (not (memq nil (mapcar (lambda (x) (eq x 0)) - (butlast + (butlast (cdr row) (- (length row) n))))) (eq (elt row n) a))) @@ -2189,6 +2260,25 @@ calc-kill calc-kill-region calc-yank)))) a (math-reject-arg a 'constp))) +;;; Some functions for working with error forms. +(defun math-get-value (x) + "Get the mean value of the error form X. +If X is not an error form, return X." + (if (eq (car-safe x) 'sdev) + (nth 1 x) + x)) + +(defun math-get-sdev (x &optional one) + "Get the standard deviation of the error form X. +If X is not an error form, return 1." + (if (eq (car-safe x) 'sdev) + (nth 2 x) + (if one 1 0))) + +(defun math-contains-sdev-p (ls) + "Non-nil if the list LS contains an error form." + (let ((ls (if (eq (car-safe ls) 'vec) (cdr ls) ls))) + (memq t (mapcar (lambda (x) (eq (car-safe x) 'sdev)) ls)))) ;;; Coerce integer A to be a small integer. [S I] (defun math-fixnum (a) @@ -2202,7 +2292,7 @@ calc-kill calc-kill-region calc-yank)))) (defun math-fixnum-big (a) (if (cdr a) - (+ (car a) (* (math-fixnum-big (cdr a)) 1000)) + (+ (car a) (* (math-fixnum-big (cdr a)) math-bignum-digit-size)) (car a))) (defvar math-simplify-only nil) @@ -2290,15 +2380,15 @@ calc-kill calc-kill-region calc-yank)))) (and (symbolp (car math-normalize-a)) (or (eq calc-simplify-mode 'none) (and (eq calc-simplify-mode 'num) - (let ((aptr (setq math-normalize-a + (let ((aptr (setq math-normalize-a (cons (car math-normalize-a) - (mapcar 'math-normalize + (mapcar 'math-normalize (cdr math-normalize-a)))))) (while (and aptr (math-constp (car aptr))) (setq aptr (cdr aptr))) aptr))) - (cons (car math-normalize-a) + (cons (car math-normalize-a) (mapcar 'math-normalize (cdr math-normalize-a)))))) @@ -2679,8 +2769,8 @@ calc-kill calc-kill-region calc-yank)))) (setq mmt-nextval (funcall math-mt-func mmt-expr)) (not (equal mmt-expr mmt-nextval))) (setq mmt-expr mmt-nextval - math-mt-many (if (> math-mt-many 0) - (1- math-mt-many) + math-mt-many (if (> math-mt-many 0) + (1- math-mt-many) (1+ math-mt-many)))) (if (or (Math-primp mmt-expr) (<= math-mt-many 0)) @@ -2960,7 +3050,7 @@ calc-kill calc-kill-region calc-yank)))) (defun math-read-plain-expr (exp-str &optional error-check) (let* ((calc-language nil) - (math-expr-opers math-standard-opers) + (math-expr-opers (math-standard-ops)) (val (math-read-expr exp-str))) (and error-check (eq (car-safe val) 'error) @@ -3005,10 +3095,10 @@ calc-kill calc-kill-region calc-yank)))) math-read-big-baseline math-read-big-h2 new-pos p) (while (setq new-pos (string-match "\n" str pos)) - (setq math-read-big-lines + (setq math-read-big-lines (cons (substring str pos new-pos) math-read-big-lines) pos (1+ new-pos))) - (setq math-read-big-lines + (setq math-read-big-lines (nreverse (cons (substring str pos) math-read-big-lines)) p math-read-big-lines) (while p @@ -3116,7 +3206,7 @@ calc-kill calc-kill-region calc-yank)))) (concat (substring (symbol-name (car a)) 9) "(" (math-vector-to-string (nth 1 a) t) ")")) (t - (let ((op (math-assq2 (car a) math-standard-opers))) + (let ((op (math-assq2 (car a) (math-standard-ops)))) (cond ((and op (= (length a) 3)) (if (> prec (min (nth 2 op) (nth 3 op))) (concat "(" (math-format-flat-expr a 0) ")") |