Menu
▾
▴
[Maxima-commits] [git] Maxima CAS branch, master, updated. branch-5_30-base-91-ga5d5e72
|
From: Rupert S. <rsw...@us...> - 2013-05-22 11:32:12
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Maxima CAS".
The branch, master has been updated
via a5d5e72f8435f7bfc45319076e887d58ea5c6e3b (commit)
via d7c8841c011620f842259f22c3f3980a5faab94d (commit)
via b650fb35311b33070c1bcc9c640d66671e89a7d6 (commit)
from 452263546898ba7280700b12f06444c05823f03b (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a5d5e72f8435f7bfc45319076e887d58ea5c6e3b
Author: Rupert Swarbrick <rsw...@gm...>
Date: Wed May 22 12:28:27 2013 +0100
Add a test for sign of squared expressions
diff --git a/tests/rtest_sign.mac b/tests/rtest_sign.mac
index 0a6bd73..f43a3e4 100644
--- a/tests/rtest_sign.mac
+++ b/tests/rtest_sign.mac
@@ -1005,9 +1005,6 @@ false;
(declare (x, constant), declare (y, constant), assume (x > y), is (x>y));
true$
-kill(all);
-done$
-
/* facts in assume database not cleaned up by 'sign' */
(kill (foo), foo : %e^(abs(uu)+uu)*(uu/abs(uu)+1)+%e^(abs(uu)-uu)*(uu/abs(uu)-1), 0);
@@ -1026,3 +1023,12 @@ map('sign,[sqrt(x),x]);
buddy(sqrt(x),abs(x)));
abs(x);
+/* Ensure that asksign1 deals correctly with squared expressions */
+(assume (notequal(n, 1)), 0);
+0$
+
+is ((n-1)^2 > 0);
+true$
+
+kill(all);
+done$
commit d7c8841c011620f842259f22c3f3980a5faab94d
Author: Rupert Swarbrick <rsw...@gm...>
Date: Wed May 22 12:25:03 2013 +0100
Reorder the contents of asksign1 slightly to avoid repetition
This also avoids a silly bug where I had a missing CDR call on one
branch when executing this (almost) repeated code. Now making such a
mistake is impossible...
diff --git a/src/compar.lisp b/src/compar.lisp
index b59a3cb..44be823 100644
--- a/src/compar.lisp
+++ b/src/compar.lisp
@@ -886,19 +886,22 @@ relational knowledge is contained in the default context GLOBAL.")
(let ($radexpand)
(declare (special $radexpand))
(sign1 $askexp))
- (cond ((has-int-symbols $askexp) '$pnz)
- ((member sign '($pos $neg $zero $imaginary) :test #'eq) sign)
- ((null odds)
- (setq $askexp (lmul evens)
- sign (cdr (assol $askexp *local-signs*)))
- (ensure-sign $askexp '$znz t))
- (t
- (if minus (setq sign (flip sign)))
- (setq $askexp
- (lmul (nconc odds (mapcar #'(lambda (l) (pow l 2)) evens))))
- (let ((domain sign))
- (setf sign (assol $askexp *local-signs*))
- (ensure-sign $askexp domain)))))
+ (cond
+ ((has-int-symbols $askexp) '$pnz)
+ ((member sign '($pos $neg $zero $imaginary) :test #'eq) sign)
+ (t
+ (let ((domain sign) (squared nil))
+ (cond
+ ((null odds)
+ (setq $askexp (lmul evens)
+ domain '$znz
+ squared t))
+ (t
+ (if minus (setq sign (flip sign)))
+ (setq $askexp
+ (lmul (nconc odds (mapcar #'(lambda (l) (pow l 2)) evens))))))
+ (setq sign (cdr (assol $askexp *local-signs*)))
+ (ensure-sign $askexp domain squared)))))
(defun match-sign (sgn domain expression squared)
"If SGN makes sense for DOMAIN store the result (see ENSURE-SIGN) and return
commit b650fb35311b33070c1bcc9c640d66671e89a7d6
Author: Rupert Swarbrick <rsw...@gm...>
Date: Wed May 22 12:15:05 2013 +0100
Fix bug in asksign
I introduced this bug when refactoring the code in
February. Basically, I hadn't realised that when someone calls
asksign(x^2), we actually ask for the sign of x (asking whether it's
zero or nonzero) and then treat any negatives as positives. This patch
puts the behaviour back in.
diff --git a/src/compar.lisp b/src/compar.lisp
index 0f3d5ce..b59a3cb 100644
--- a/src/compar.lisp
+++ b/src/compar.lisp
@@ -891,7 +891,7 @@ relational knowledge is contained in the default context GLOBAL.")
((null odds)
(setq $askexp (lmul evens)
sign (cdr (assol $askexp *local-signs*)))
- (ensure-sign $askexp '$znz))
+ (ensure-sign $askexp '$znz t))
(t
(if minus (setq sign (flip sign)))
(setq $askexp
@@ -900,36 +900,48 @@ relational knowledge is contained in the default context GLOBAL.")
(setf sign (assol $askexp *local-signs*))
(ensure-sign $askexp domain)))))
-(defun match-sign (sgn domain expression)
+(defun match-sign (sgn domain expression squared)
"If SGN makes sense for DOMAIN store the result (see ENSURE-SIGN) and return
-it. Otherwise, return NIL."
- ;; We have a hit if the answer (sign) is one of the first list and the
- ;; question (domain) was one of the second.
+it. Otherwise, return NIL. If SQUARED is true, we are actually looking for the
+sign of the square, so any negative results are converted to positive."
+ ;; The entries in BEHAVIOUR are of the form
+ ;; (MATCH DOMAINS REGISTRAR SIGN SIGN-SQ)
+ ;;
+ ;; The algorithm goes as follows:
+ ;;
+ ;; Look for SGN in MATCH. If found, use REGISTRAR to store SIGN for the
+ ;; expression and then return SIGN if SQUARED is false or SIGN-SQ if it is
+ ;; true.
(let* ((behaviour
- '((($pos |$P| |$p| $positive) (nil $znz $pz $pn $pnz) tdpos $pos)
- (($neg |$N| |$n| $negative) (nil $znz $nz $pn $pnz) tdneg $neg)
- (($zero |$Z| |$z| 0 0.0) (nil $znz $pz $nz $pnz) tdzero $zero)
- (($pn $nonzero $nz $nonz $non0) ($znz) tdpn $pn)))
+ '((($pos |$P| |$p| $positive) (nil $znz $pz $pn $pnz) tdpos $pos $pos)
+ (($neg |$N| |$n| $negative) (nil $znz $nz $pn $pnz) tdneg $neg $pos)
+ (($zero |$Z| |$z| 0 0.0) (nil $znz $pz $nz $pnz) tdzero $zero $zero)
+ (($pn $nonzero $nz $nonz $non0) ($znz) tdpn $pn $pos)))
(hit (find-if (lambda (bh)
(and (member sgn (first bh) :test #'equal)
(member domain (second bh) :test #'eq)))
behaviour)))
(when hit
- (funcall (third hit) expression)
- (setq sign
- (if minus (flip (fourth hit)) (fourth hit))))))
+ (let ((registrar (third hit))
+ (found-sign (if squared (fifth hit) (fourth hit))))
+ (funcall registrar expression)
+ (setq sign
+ (if (and minus (not squared)) (flip found-sign) found-sign))))))
-(defun ensure-sign (expr &optional domain)
+(defun ensure-sign (expr &optional domain squared)
"Try to determine the sign of EXPR. If DOMAIN is not one of the special values
described below, we try to tell whether EXPR is positive, negative or zero. It
can be more specialised ($pz => positive or zero; $nz => negative or zero; $pn
=> positive or negative; $znz => zero or nonzero).
+If SQUARED is true, then we're actually interested in the sign of EXPR^2. As
+such, a nonzero sign should be regarded as positive.
+
When calling ENSURE-SIGN, set the special variable SIGN to the best current
guess for the sign of EXPR. The function returns the sign, calls one of (TDPOS
TDNEG TDZERO TDPN) to store it, and also sets SIGN."
(loop
- (let ((new-sign (match-sign sign domain expr)))
+ (let ((new-sign (match-sign sign domain expr squared)))
(when new-sign (return new-sign)))
(setf sign (retrieve
(list '(mtext)
-----------------------------------------------------------------------
Summary of changes:
src/compar.lisp | 69 ++++++++++++++++++++++++++++++-------------------
tests/rtest_sign.mac | 12 ++++++--
2 files changed, 51 insertions(+), 30 deletions(-)
hooks/post-receive
--
Maxima CAS
|