[Maxima-commits] CVS: maxima/src rpart.lisp,1.25,1.26

[Dieter K. <cra...@us...>]

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

Modified Files:
	rpart.lisp 
Log Message:
Avoiding asksign in the routine risplit-expt. When the sign is not known return a general form.

The routine risplit-expt tries to simplify expressions like sqrt(x*%i+y) or x^(p/q), where x is positive or negative. Now expressions like rectform(sqrt(x+%i*y)) or rectform(asin(x+%i*y)) will simplify without asking the sign.

Tested with GCL 2.6.8 and CLISP 2.44. No problems with the testsuite and share_testsuite.

Index: rpart.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/rpart.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- rpart.lisp	11 May 2009 22:05:35 -0000	1.25
+++ rpart.lisp	2 Jun 2009 22:40:09 -0000	1.26
@@ -263,29 +263,56 @@
 		    (setq ris (risplit (cadr l)))
 		    (or (= (caddr pow) 2) (=0 (cdr ris)))))
 	   (cond ((=0 (cdr ris))
-		  (case (cond ((mnegp (car ris)) '$negative)
-			      (implicit-real '$positive)
-			      (t (asksign (car ris))))
-		    ($negative (risplit (mul2 (power -1 pow) (power (neg (car ris)) pow))))
+		  (case (cond ((mnegp (car ris)) '$neg)
+			      (implicit-real '$pos)
+			      (t ($sign (car ris)))) ; Use $sign not asksign
+		    ($neg (risplit (mul2 (power -1 pow) 
+                                         (power (neg (car ris)) pow))))
 		    ($zero (cons (power 0 pow) 0))
-		    (t (cons (power (car ris) pow) 0))))
+                    ($pos (cons (power (car ris) pow) 0)) ; Add the case $pos
+                    (t
+                     ;; The sign is unknown. Return a general form.
+                     (let ((sp (risplit (caddr l)))
+		           (aa (absarg1 (cadr l))))
+                       (let ((pre (mul (powers '$%e (mul (cdr aa) (mul (cdr sp) -1)))
+                                       (powers (car aa) (car sp))))
+                             (post (add (mul (cdr sp) (take '(%log) (car aa)))
+                                        (mul (car sp) (cdr aa)))))
+                       (cons (mul pre (take '(%cos) post))
+                             (mul pre (take '(%sin) post))))))))
 		 (t
 		  (let ((abs2 (spabs ris))
 			(n (abs (cadr pow)))
 			(pos? (> (cadr pow) -1)))
-		    (let ((abs (power abs2 (1//2))))
-		      (divcarcdr
-		       (expanintexpt
-			(cons (power (add abs (car ris)) (1//2))
-			      (porm (let ((a pos?)
-					  (b (eq (asksign (cdr ris)) '$negative)))
-				      (cond (a (not b))
-					    (b t)))
-				    (power (sub abs (car ris)) (1//2))))
-			n)
-		       (if pos?
-			   (power 2 (div n 2))
-			   (power (mul 2 abs2) (div n 2)))))))))
+		    (let ((abs (power abs2 (1//2)))
+                          (sign-imagpart ($sign (cdr ris)))) ; Do we know the sign?
+                      (cond ((member sign-imagpart '($neg $pos))
+                             (divcarcdr
+                               (expanintexpt
+                                 (cons (power (add abs (car ris)) (1//2))
+                                       (porm (let ((a pos?)
+                                                   (b (eq (asksign (cdr ris)) 
+                                                          '$negative)))
+                                               (cond (a (not b))
+                                                     (b t)))
+                                             (power (sub abs (car ris)) (1//2))))
+                                 n)
+                               (if pos?
+                                   (power 2 (div n 2))
+                                   (power (mul 2 abs2) (div n 2)))))
+                            (t
+                             ;; The sign is unknown. Return a general form.
+                             (let ((sp (risplit (caddr l)))
+                                   (aa (absarg1 (cadr l))))
+                               (let ((pre (mul (powers '$%e 
+                                                       (mul (cdr aa) 
+                                                       (mul (cdr sp) -1)))
+                                               (powers (car aa) (car sp))))
+                                     (post (add (mul (cdr sp) 
+                                                     (take '(%log) (car aa)))
+                                                (mul (car sp) (cdr aa)))))
+                                 (cons (mul pre (take '(%cos) post))
+                                       (mul pre (take '(%sin) post))))))))))))
 	  ((and (floatp (setq ris (cadr l))) (floatp pow))
 	   (risplit (let (($numer t))
 		      (exptrl ris pow))))