Menu
▾
▴
#2937 dotscrules and antisymmetric
Declaring . to be antisymmetric and setting dotscrules=true gives an erroneous simplification:
(%i1) (declare(a,scalar), declare(".",antisymmetric))$
(%i2) b . a;
(%o2) - a . b
Which is correct.
(%i3) b . a, dotscrules=true;
(%o3) - a b
Which is incorrect.
The problem is that antisym does not respect dotscrules.
Here is a patch that fixes the problem: antisym first checks if the dotscrules is true and if the expression should be simplified by simpnct, before doing its normal business.
The patch also removes antisym-sign as a special variable.
diff --git a/src/asum.lisp b/src/asum.lisp
index c1d5836..158b6f7 100644
--- a/src/asum.lisp
+++ b/src/asum.lisp
@@ -993,26 +993,29 @@ summation when necessary."
(setq opers (cons '$antisymmetric opers)
*opers-list (cons '($antisymmetric . antisym) *opers-list))
-(declare-top (special antisym-sign))
-
(defmfun antisym (e z)
- (let ((l (mapcar #'(lambda (q) (simpcheck q z)) (cdr e))))
- (let (antisym-sign) (if (or (not (eq (caar e) 'mnctimes)) (freel l 'mnctimes))
- (setq l (bbsort1 l)))
+ (when (and $dotscrules (mnctimesp e))
+ (setq e (simpnct e 1 nil)))
+ (let ((antisym-sign nil)
+ (l (mapcar #'(lambda (q) (simpcheck q z)) (cdr e))))
+ (when (or (not (eq (caar e) 'mnctimes)) (freel l 'mnctimes))
+ (multiple-value-setq (l antisym-sign) (bbsort1 l)))
(cond ((equal l 0) 0)
- ((prog1 (null antisym-sign) (setq e (oper-apply (cons (car e) l) t)))
+ ((prog1
+ (null antisym-sign)
+ (setq e (oper-apply (cons (car e) l) t)))
e)
- (t (neg e))))))
+ (t (neg e)))))
(defun bbsort1 (l)
- (prog (sl sl1)
- (if (or (null l) (null (cdr l))) (return l))
- (setq antisym-sign nil sl (list nil (car l)))
+ (prog (sl sl1 antisym-sign)
+ (if (or (null l) (null (cdr l))) (return (values l antisym-sign))
+ (setq sl (list nil (car l))))
loop (setq l (cdr l))
- (if (null l) (return (nreverse (cdr sl))))
+ (if (null l) (return (values (nreverse (cdr sl)) antisym-sign)))
(setq sl1 sl)
loop1(cond ((null (cdr sl1)) (rplacd sl1 (cons (car l) nil)))
- ((alike1 (car l) (cadr sl1)) (return 0))
+ ((alike1 (car l) (cadr sl1)) (return (values 0 nil)))
((great (car l) (cadr sl1)) (rplacd sl1 (cons (car l) (cdr sl1))))
(t (setq antisym-sign (not antisym-sign) sl1 (cdr sl1)) (go loop1)))
(go loop)))
diff --git a/src/mdot.lisp b/src/mdot.lisp
index 1c3b1b8..cc6a435 100644
--- a/src/mdot.lisp
+++ b/src/mdot.lisp
@@ -86,7 +86,6 @@ is no need to rely on the setting of this switch.")
;; Specials defined elsewhere.
(declare-top (special $expop $expon ; Controls behavior of EXPAND
- antisym-sign ; track reversals when reordering noncommutative products
errorsw))
;; The operators "." and "^^" distribute over equations.
@@ -382,12 +381,11 @@ is no need to rely on the setting of this switch.")
(rplacd (last inner-product) (ncons (car rest))))))
(defun simpnct-antisym-check (l check)
- (let (antisym-sign)
(cond ((and (get 'mnctimes '$antisymmetric) (cddr l))
- (setq l (bbsort1 l))
+ (multiple-value-bind (l antisym-sign) (bbsort1 l)
(cond ((equal l 0) 0)
((prog1 (null antisym-sign)
(setq l (eqtest (cons '(mnctimes) l) check)))
l)
- (t (neg l))))
- (t (eqtest (cons '(mnctimes) l) check)))))
+ (t (neg l)))))
+ (t (eqtest (cons '(mnctimes) l) check))))
The testsuite runs without any unexpected error and we get the correct simplification.
~~~~~
Maxima branch_5_36_base_14_g7b066a8 http://maxima.sourceforge.net
using Lisp SBCL 1.2.4.debian
Distributed under the GNU Public License. See the file COPYING.
Dedicated to the memory of William Schelter.
The function bug_report() provides bug reporting information.
(%i1) load("src/mdot.lisp");
(%o1) src/mdot.lisp
(%i2) load("src/asum.lisp");
(%o2) src/asum.lisp
(%i3) (declare(a,scalar), declare(".",antisymmetric))$
(%i4) b . a;
(%o4) - a . b
(%i5) b . a, dotscrules=true;
(%o5) a b
~~~~~~
This is fixed in commit 20b4b5e. There are 2 extra corner cases handled in that commit that are not in the patch above: 1. when simpnct returns a mapatom (invalid input to antisym), return that; 2. prevent simpnct from returning a term involving ^^ by binding $dotexptsimp to nil.