The following sign-log function runs the testsuite with no errors and
it reduces the run time from about 217.8 seconds to 197.734 seconds
(Intel Core i3 380M 2.53 GHz, 64 bit Clozure 1.6, ...). It runs
the share testsuite with no errors, but it doesn't change the run time
for the share testsuite all that much.
The testsuite spends about 33 seconds (out of about 200) finding the sign
of mplus expressions. Both mtimes and mexpt expressions are fairly spendy
too--%log expressions rank fourth in run time. The proposed sign-log function
reduces the time for %log expressions from about 20 seconds to 2 seconds.
For the testsuite, the run time of sign isn't dominated by a few nasty
cases--the sign function is called many times on non-nasty expressions.
Comments are welcomed. Proposed sign-log:
(defun sign-log (x)
(setq x (cadr x))
(setq sign
(cond ((eq t (mgrp x 0))
(cond ((eq t (mgrp 1 x)) '$neg)
((eq t (meqp x 1)) '$zero);; log(1) = 0.
((eq t (mgrp x 1)) '$pos)
((eq t (mgqp x 1)) '$pz)
(t '$pnz)))
((and *complexsign* (eql 1 (sratsimp (mul x (take '($conjugate) x)))))
'$imaginary)
(*complexsign* '$complex)
(t '$pnz))))
Current sign-log (I wrote (the slow?) parts of this function)
???????????????? ???????????????? ? ? ?
(defun sign-log (x)
??(setq x (cadr x)) ;; looking at sign of log(x)
??(cond ((eq t (meqp x 1)) (setf sign '$zero)) ;; log(1) = 0.
???????????????? ;; for x on the unit circle and x # 1, log(x) is pure imaginary
???????????????? ((and ?*complexsign* (eq t (meqp 1 (take '(mabs) x))) (eq t (mnqp x 1)))
???????????????? (setf sign '$imaginary))
???????????????? ;; log(x) is positive for x > 1
???????????????? ((eq t (mgrp x 1)) (setf sign '$pos))
???????????????? ((eq t (mgqp x 1)) (setf sign '$pz))
???????????????? ;; log(x) is negative for 0 < x < 1.
???????????????? ((and (eq t (mgrp x 0)) (eq t (mgrp 1 x))) (setf sign '$neg))
???????????????? ;; log(x) is real for x > 0
???????????????? ((eq t (mgrp x 0)) (setf sign '$pnz))
???????????????? ;; Nothing is known. ?Return $complex if allowed,
???????????????? ;; ?otherwise pnz
???????????????? (*complexsign* (setf sign '$complex))
???????????????? (t (setf sign '$pnz)))
??sign)
--Barton