From: Barton W. <wil...@us...> - 2007-01-16 20:38:36
|
Update of /cvsroot/maxima/maxima/src In directory sc8-pr-cvs7.sourceforge.net:/tmp/cvs-serv15811/src Modified Files: simp.lisp Log Message: fixes for simpabs bugs: 1636746, 1635370, 1635322, and 1635320 Index: simp.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/src/simp.lisp,v retrieving revision 1.22 retrieving revision 1.23 diff -u -d -r1.22 -r1.23 --- simp.lisp 31 May 2006 17:34:54 -0000 1.22 +++ simp.lisp 16 Jan 2007 20:38:30 -0000 1.23 @@ -914,24 +914,35 @@ ;;(DEFUN QSNT (X Y) (SIMPLIFY (LIST '(MTIMES) X (LIST '(MEXPT) Y -1)))) -(defmfun simpabs (x y z) +(setf (get '%mabs 'operators) 'simpabs) + +(defmfun simpabs (x y z) (oneargcheck x) (setq y (simpcheck (cadr x) z)) - (cond ((numberp y) (abs y)) - ((or (ratnump y) ($bfloatp y)) (list (car y) (abs (cadr y)) (caddr y))) + (cond ((numberp y) (abs y)) + ((or (arrayp y) ($member y $arrays)) `((mabs simp) ,y)) + ((or (ratnump y) ($bfloatp y)) (list (car y) (abs (cadr y)) (caddr y))) + ((taylorize 'mabs (second x))) + ((memq y '($inf $infinity $minf)) '$inf) + ((memq y '($ind $und)) y) ((eq (setq z (csign y)) t) (cabs y)) - ((memq z '($pos $pz)) y) - ((memq z '($neg $nz)) (neg y)) + ((memq z '($pos $pz)) y) + ((memq z '($neg $nz)) (neg y)) ((eq z '$zero) 0) ((and (mexptp y) (integerp (caddr y))) - (list (car y) (simpabs (list '(mabs) (cadr y)) nil t) (caddr y))) + ;;(list (car y) (simpabs (list '(mabs) (cadr y)) nil t) (caddr y))) + (list (car y) (simplifya (list '(mabs) (cadr y)) nil) (caddr y))) ((mtimesp y) - (muln (mapcar #'(lambda (u) (simpabs (list '(mabs) u) nil t)) (cdr y)) t)) + ;; (muln (mapcar #'(lambda (u) (simpabs (list '(mabs) u) nil t)) (cdr y)) t) + (muln (mapcar #'(lambda (u) (simplifya (list '(mabs) u) nil)) (cdr y)) t)) ((mminusp y) (list '(mabs simp) (neg y))) ((mbagp y) (cons (car y) - (mapcar #'(lambda (u) (simpabs (list '(mabs) u) nil t)) (cdr y)))) + (mapcar #'(lambda (u);;(simpabs (list '(mabs) u) nil t) + (simplifya (list '(mabs) u) nil)) (cdr y)))) + ((op-equalp y '$conjugate) (simplifya `((mabs) ,(first (margs y))) nil)) (t (eqtest (list '(mabs) y) x)))) + (defun pls (x out) (prog (fm plusflag) |