diff options
Diffstat (limited to 'lisp/calc')
| -rw-r--r-- | lisp/calc/calc-alg.el | 26 | ||||
| -rw-r--r-- | lisp/calc/calc-arith.el | 29 | ||||
| -rw-r--r-- | lisp/calc/calc-ext.el | 33 | ||||
| -rw-r--r-- | lisp/calc/calc-misc.el | 7 |
4 files changed, 90 insertions, 5 deletions
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index ada18830988..11d550bb5d2 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -91,6 +91,32 @@ (calc-top-n 1)) (and n (list (prefix-numeric-value n))))))) +;;; Write out powers (a*b*...)^n as a*b*...*a*b*... +(defun calcFunc-writeoutpower (expr) + (math-normalize (math-map-tree 'math-write-out-power expr))) + +(defun math-write-out-power (expr) + (if (eq (car-safe expr) '^) + (let ((a (nth 1 expr)) + (n (nth 2 expr)) + (prod (nth 1 expr)) + (i 1)) + (if (and (integerp n) + (> n 0)) + (progn + (while (< i n) + (setq prod (math-mul prod a)) + (setq i (1+ i))) + prod) + expr)) + expr)) + +(defun calc-writeoutpower () + (interactive) + (calc-slow-wrapper + (calc-enter-result 1 "expp" + (calcFunc-writeoutpower (calc-top-n 1))))) + (defun calc-collect (&optional var) (interactive "sCollect terms involving: ") (calc-slow-wrapper diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index feb3c9d25a8..f8057c5f1b9 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -1386,6 +1386,7 @@ (and (eq (car-safe b) '^) (Math-looks-negp (nth 2 b)) (not (and (eq (car-safe a) '^) (Math-looks-negp (nth 2 a)))) + (not (math-known-matrixp (nth 1 b))) (math-div a (math-normalize (list '^ (nth 1 b) (math-neg (nth 2 b)))))) (and (eq (car-safe a) '/) @@ -1427,6 +1428,30 @@ (list 'calcFunc-idn (math-mul a (nth 1 b)))) (and (math-known-matrixp a) (math-mul a (nth 1 b))))) + (and (math-identity-matrix-p a t) + (or (and (eq (car-safe b) 'calcFunc-idn) + (= (length b) 2) + (list 'calcFunc-idn (math-mul + (nth 1 (nth 1 a)) + (nth 1 b)) + (1- (length a)))) + (and (math-known-scalarp b) + (list 'calcFunc-idn (math-mul + (nth 1 (nth 1 a)) b) + (1- (length a)))) + (and (math-known-matrixp b) + (math-mul (nth 1 (nth 1 a)) b)))) + (and (math-identity-matrix-p b t) + (or (and (eq (car-safe a) 'calcFunc-idn) + (= (length a) 2) + (list 'calcFunc-idn (math-mul (nth 1 a) + (nth 1 (nth 1 b))) + (1- (length b)))) + (and (math-known-scalarp a) + (list 'calcFunc-idn (math-mul a (nth 1 (nth 1 b))) + (1- (length b)))) + (and (math-known-matrixp a) + (math-mul a (nth 1 (nth 1 b)))))) (and (math-looks-negp b) (math-mul (math-neg a) (math-neg b))) (and (eq (car-safe b) '-) @@ -1706,7 +1731,9 @@ (math-div-new-non-trig term)))) (defun math-div-symb-fancy (a b) - (or (and math-simplify-only + (or (and (math-known-matrixp b) + (math-mul a (math-pow b -1))) + (and math-simplify-only (not (equal a math-simplify-only)) (list '/ a b)) (and (Math-equal-int b 1) a) diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index db370f766d9..563bcd9b023 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -659,7 +659,7 @@ ("calc-alg" calc-has-rules math-defsimplify calc-modify-simplify-mode calcFunc-collect calcFunc-esimplify calcFunc-islin calcFunc-islinnt calcFunc-lin calcFunc-linnt -calcFunc-simplify calcFunc-subst math-beforep +calcFunc-simplify calcFunc-subst calcFunc-writeoutpower math-beforep math-build-polynomial-expr math-expand-formula math-expr-contains math-expr-contains-count math-expr-depends math-expr-height math-expr-subst math-expr-weight math-integer-plus math-is-linear @@ -923,7 +923,7 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand calc-expand-formula calc-factor calc-normalize-rat calc-poly-div calc-poly-div-rem calc-poly-gcd calc-poly-rem calc-simplify -calc-simplify-extended calc-substitute) +calc-simplify-extended calc-substitute calc-writeoutpower) ("calcalg2" calc-alt-summation calc-derivative calc-dump-integral-cache calc-integral calc-num-integral @@ -2107,6 +2107,35 @@ calc-kill calc-kill-region calc-yank)))) (and (cdr dims) (= (car dims) (nth 1 dims))))) +;;; True if MAT is an identity matrix. +(defun math-identity-matrix-p (mat &optional mul) + (if (math-square-matrixp mat) + (let ((a (if mul + (nth 1 (nth 1 mat)) + 1)) + (n (1- (length mat))) + (i 1)) + (while (and (<= i n) + (math-ident-row-p (nth i mat) i a)) + (setq i (1+ i))) + (if (> i n) + a + nil)))) + +(defun math-ident-row-p (row n &optional a) + (unless a + (setq a 1)) + (and + (not (memq nil (mapcar + (lambda (x) (eq x 0)) + (nthcdr (1+ n) row)))) + (not (memq nil (mapcar + (lambda (x) (eq x 0)) + (butlast + (cdr row) + (- (length row) n))))) + (eq (elt row n) a))) + ;;; True if A is any scalar data object. [P x] (defun math-objectp (a) ; [Public] (or (integerp a) diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index e8c0ea4b658..ba80f455b4f 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -646,8 +646,11 @@ loaded and the keystroke automatically re-typed." (or (math-with-extra-prec 2 (math-matrix-inv-raw m)) (math-reject-arg m "*Singular matrix")) (math-reject-arg m 'square-matrixp))) - (math-div 1 m))) - + (if (and + (require 'calc-arith) + (math-known-matrixp m)) + (math-pow m -1) + (math-div 1 m)))) (defun math-do-working (msg arg) (or executing-kbd-macro |