From cbd4e89beaf480605fc6b690a150c5382499e4f6 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Fri, 28 Oct 2005 03:51:00 +0000 Subject: Add functions to autoloads. (math-identity-matrix-p, math-ident-row-p): New functions. --- lisp/calc/calc-ext.el | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) (limited to 'lisp/calc') 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) -- cgit v1.2.3 From 7199ddd28ea6c24170119687f24dc7bc5653af29 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Fri, 28 Oct 2005 03:51:36 +0000 Subject: (calc-mul-symb-fancy): Add checks for multiplication by an identity matrix, don't turn multiplication by an inverse matrix into division. (math-div-symbol-fancy): Replace division by matrices with multiplication by inverse. --- lisp/calc/calc-arith.el | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) (limited to 'lisp/calc') 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) -- cgit v1.2.3 From 5c0e273a4c333afc812218c88cea0415f4ebeed3 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Fri, 28 Oct 2005 03:52:08 +0000 Subject: (calcFunc-inv): Check for symbolic matrices. --- lisp/calc/calc-misc.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp/calc') 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 -- cgit v1.2.3 From 93e7f889422e0d4475cd0ef248470e4125067f32 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Fri, 28 Oct 2005 03:52:38 +0000 Subject: (calcFunc-writeoutpower, math-write-out-power, calc-writeoutpower): New functions. --- lisp/calc/calc-alg.el | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) (limited to 'lisp/calc') 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 -- cgit v1.2.3