[Maxima-commits] CVS: maxima/src simp.lisp,1.59,1.60

[Barton W. <wil...@us...>]

Update of /cvsroot/maxima/maxima/src
In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv27504

Modified Files:
	simp.lisp 
Log Message:
Additional simplifications for signum:

 o signum(signum(x)) --> signum(x),
 o signum(p * x) --> signum(x), where p > 0,
 o signum(n * x) --> signum(x), where n < 0,
 o new criteria for reflection identity (consistent with trig functions).

Index: simp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/simp.lisp,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -d -r1.59 -r1.60
--- simp.lisp	14 Oct 2008 21:14:36 -0000	1.59
+++ simp.lisp	17 Nov 2008 12:55:41 -0000	1.60
@@ -1368,14 +1368,23 @@
 (defmfun simpsignum (x y z) 
   (oneargcheck x)
   (setq y (simpcheck (cadr x) z))
-  (cond ((mnump y)
-	 (setq y (num1 y)) (cond ((plusp y) 1) ((minusp y) -1) (t 0))) 
-	((eq (setq z (csign y)) t) (eqtest (list '(%signum) y) x))
-	((eq z '$pos) 1) 
-	((eq z '$neg) -1) 
-	((eq z '$zero) 0) 
-	((mminusp y) (neg (take '(%signum) (neg y))))
-	(t (eqtest (list '(%signum) y) x))))
+  (setq z (csign y))
+  ;; When csign thinks y is complex, let it be.
+  (cond ((eq t z) (eqtest (list '(%signum) y) x))
+	(t 
+	 ;; positive * x --> x and negative * x --> -1 * x.
+	 (if (mtimesp y)
+	     (setq y (muln (mapcar #'(lambda (s) (let ((sgn (csign s)))
+						   (cond ((eq sgn '$neg) -1)
+							 ((eq sgn '$pos) 1)
+							 (t s)))) (margs y)) t)))
+
+	 (cond ((and (not ($mapatom y)) (eq (mop y) '%signum)) y) ;; signum(signum(x)) --> signum(x)
+	       ((eq z '$pos) 1) 
+	       ((eq z '$neg) -1) 
+	       ((eq z '$zero) 0) 
+	       ((great (neg y) y) (neg (take '(%signum) (neg y)))) ;; signum(x) --> -signum(-x).
+	       (t (eqtest (list '(%signum) y) x))))))
 
 (defmfun exptrl (r1 r2)
   (cond ((equal r2 1) r1)