Is 1 zero or nonzero?
- Subject: Is 1 zero or nonzero?
- From: Barton Willis
- Date: Fri, 15 Jun 2012 10:21:45 +0000
>> Does anybody know something about this silly askskign? Does some
>> special variable need to be set?
>I don't know anything about it, but if you post whatever code you are
>working with, I will give it a try.
My first attempt to fix http://sourceforge.net/tracker/index.php?func=detail&aid=3517034&group_id=4933&atid=104933
was to insert
((eq '$zero ($csign l))
(setq l ($expand l))
(cons l l))
This gives the bug:
(%i7) polarform(%i * inf);
"Is "1" zero or nonzero?"zero;
(%o7) %e^((%i*%pi)/2)*inf
Looking at csign code is compar, instead I fixed the bug with
;; ((eq '$zero (let ((sign-imag-errp nil)) (catch 'sign-imag-err ($sign l))))
;; (setq l ($expand l))
;; (cons l l))
Code for experimentation:
(defun absarg (l &optional (absflag nil))
;; Commenting out the the expansion of the expression l. It seems to be not
;; necessary, but can cause expression swelling (DK 01/2010).
; (setq l ($expand l))
(cond ((atom l)
(cond ((eq l '$%i)
(cons 1 (simplify '((mtimes) ((rat simp) 1 2) $%pi))))
((numberp l)
(cons (abs l) (argnum l)))
((member l '($%e $%pi) :test #'eq) (cons l 0))
((eq l '$infinity) (cons '$inf '$ind))
((decl-complexp l)
(cons (list '(mabs simp) l) ; noun form with mabs
(list '(%carg simp) l)))
(absflag (cons (take '(mabs) l) 0))
(t
;; At this point l is representing a real value. Try to
;; determine the sign and return a general form when the sign is
;; unknown.
(let ((gs (if (eq rischp l) '$pos ($sign l))))
(cond ((member gs '($pos $pz)) (cons l 0))
((eq gs '$zero) (cons 0 0))
((eq gs '$neg)
(cons (neg l) (simplify '$%pi)))
(t (cons (take '(mabs) l) (genatan 0 l))))))))
;; polarform(%i * inf) --> is 1 zero or nonzero
((eq '$zero ($csign l))
(setq l ($expand l))
(cons l l))
;; committed code:
;; ((eq '$zero (let ((sign-imag-errp nil)) (catch 'sign-imag-err ($sign l))))
;; (setq l ($expand l))
;; (cons l l))
((member (caar l) '(rat bigfloat) :test #'eq)
(cons (list (car l) (abs (cadr l)) (caddr l))
(argnum (cadr l))))
((eq (caar l) 'mtimes)
(do ((n (cdr l) (cdr n))
(abars)
(argl () (cons (cdr abars) argl))
(absl () (rplacd abars absl)))
(())
(unless n
(return (cons (muln absl t) (2pistrip (addn argl t)))))
(setq abars (absarg (car n) absflag))))
((eq (caar l) 'mexpt)
;; An expression z^a
(let ((aa (absarg (cadr l) nil)) ; (abs(z) . arg(z))
(sp (risplit (caddr l))) ; (realpart(a) . imagpart(a))
($radexpand nil))
(cond ((and (zerop1 (cdr sp))
(eq ($sign (sub 1 (take '(mabs) (car sp)))) '$pos))
;; Special case: a is real and abs(a) < 1.
;; This simplifies e.g. carg(sqrt(z)) -> carg(z)/2
(cons (mul (power (car aa) (car sp))
(power '$%e (neg (mul (cdr aa) (cdr sp)))))
(mul (caddr l) (cdr aa))))
(t
;; General case for z and a
(let ((arg (add (mul (cdr sp) (take '(%log) (car aa)))
(mul (cdr aa) (car sp)))))
(cons (mul (power (car aa) (car sp))
(power '$%e (neg (mul (cdr aa) (cdr sp)))))
(if generate-atan2
(take '($atan2)
(take '(%sin) arg)
(take '(%cos) arg))
(take '(%atan) (take '(%tan) arg)))))))))
((and (member (caar l) '(%tan %tanh) :test #'eq)
(not (=0 (cdr (risplit (cadr l))))))
(let* ((sp (risplit (cadr l)))
(2frst (mul (cdr sp) 2))
(2scnd (mul (car sp) 2)))
(when (eq (caar l) '%tanh)
(psetq 2frst 2scnd 2scnd 2frst))
(cons (let ((cosh (take '(%cosh) 2frst))
(cos (take '(%cos) 2scnd)))
(root (div (add cosh (neg cos))
(add cosh cos))
2))
(take '(%atan)
(if (eq (caar l) '%tan)
(div (take '(%sinh) 2frst) (take '(%sin) 2scnd))
(div (take '(%sin) 2frst) (take '(%sinh) 2scnd)))))))
((specrepp l) (absarg (specdisrep l) absflag))
((let ((foot (coversinemyfoot l)))
(and foot (not (=0 (cdr (risplit (cadr l))))) (absarg foot absflag))))
(t
(let ((ris (trisplit l)))
(xcons
;;; Arguments must be in this order so that the side-effect of the Atan2,
;;; that is, determining the Asksign of the argument, can happen before
;;; Take Mabs does its Sign. Blame JPG for noticing this lossage.
(if absflag 0 (genatan (cdr ris) (car ris)))
(cond ((equal (car ris) 0) (absarg-mabs (cdr ris)))
((equal (cdr ris) 0) (absarg-mabs (car ris)))
(t (powers ($expand (add (powers (car ris) 2)
(powers (cdr ris) 2))
1 0)
(half)))))))))
--Barton