From: Rupert S. <rsw...@us...> - 2013-06-21 12:11:05
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 735fb39d816cf543864345ae3aab49d9beecac19 (commit) via 12d29fa80078d2c4862baaa3333a6a9abd19a4b5 (commit) from bab3b4bbccb0154cb806a344b8fa813198eefc55 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 735fb39d816cf543864345ae3aab49d9beecac19 Author: Rupert Swarbrick <rsw...@gm...> Date: Fri Jun 21 13:05:04 2013 +0100 Fix for bug #2597 (logcontract and subscripted log) In LGCPLUS, when we acted on 42+log[x], we spotted that log[x] was a logarithm with x as argument, but we stripped out the fact that it was called as an array function. This patch fixes that behaviour in the most simple-minded way possible, just ignoring such terms. diff --git a/src/comm2.lisp b/src/comm2.lisp index 6e15576..2da15d0 100644 --- a/src/comm2.lisp +++ b/src/comm2.lisp @@ -251,7 +251,11 @@ (dolist (arg (cdr e)) (cond ((atom arg) (push arg notlogs)) - ((eq (caar arg) '%log) + ;; Only gather up log(x), not log[x]. It's not particularly obvious + ;; whether log(x)+log[y] should become log(x*y) or log[x*y], so we just + ;; ignore the fact that log[x] is a logarithm. + ((and (eq (caar arg) '%log) + (not (member 'array (car arg)))) (push (logcon (second arg)) log)) ((eq (caar arg) 'mtimes) (let ((y (lgctimes arg))) diff --git a/tests/rtest_log.mac b/tests/rtest_log.mac index 66ecf43..9db1c68 100755 --- a/tests/rtest_log.mac +++ b/tests/rtest_log.mac @@ -290,6 +290,10 @@ log(2/3*((x-1)^3)^(a/b)*(2*y-3)^(b/a)), domain:complex, logexpand:super; log(1/(1+%i)),logexpand:false; -log(1+%i); +/* Bug 2597: logcontract(42+log[x]) was returning 42+log(x) */ +is(logcontract(42+log[x]) = 42+log[x]); +true$ + /* ----- Complex characteristics -------------------------------------------- */ realpart(log(x+%i*y)); commit 12d29fa80078d2c4862baaa3333a6a9abd19a4b5 Author: Rupert Swarbrick <rsw...@gm...> Date: Fri Jun 21 12:50:19 2013 +0100 Rewrite LGCPLUS using DOTIMES and PUSH instead of DO, CONS and SETQ This doesn't change the logic at all, but makes the function much simpler to read: apart from anything else, we strip a "level of CAR" from the argument as we go. diff --git a/src/comm2.lisp b/src/comm2.lisp index 732cc34..6e15576 100644 --- a/src/comm2.lisp +++ b/src/comm2.lisp @@ -240,21 +240,34 @@ (t (logcon e)))) (t (recur-apply #'logcon e)))) +;; The logcontract algorithm for a sum. +;; +;; The function accumulates the arguments of things like log(a)+log(b) into a +;; list called LOG. It calls out to lgctimes to deal with things like +;; a*log(b). When all the arguments have been processed, it simplifies all the +;; logarithmic arguments using sratsimp. (defun lgcplus (e) - (do ((x (cdr e) (cdr x)) (log) (notlogs) (y)) - ((null x) - (cond ((null log) (subst0 (cons '(mplus) (nreverse notlogs)) e)) - (t - (setq log (let (($ratfac t)) (sratsimp (muln log t)))) - (addn (cons (lgcsimp log) notlogs) t)))) - (cond ((atom (car x)) (setq notlogs (cons (car x) notlogs))) - ((eq (caaar x) '%log) (setq log (cons (logcon (cadar x)) log))) - ((eq (caaar x) 'mtimes) - (setq y (lgctimes (car x))) - (cond ((or (atom y) (not (eq (caar y) '%log))) - (setq notlogs (cons y notlogs))) - (t (setq log (cons (cadr y) log))))) - (t (setq notlogs (cons (logcon (car x)) notlogs)))))) + (let ((log) (notlogs)) + (dolist (arg (cdr e)) + (cond + ((atom arg) (push arg notlogs)) + ((eq (caar arg) '%log) + (push (logcon (second arg)) log)) + ((eq (caar arg) 'mtimes) + (let ((y (lgctimes arg))) + (if (or (atom y) (not (eq (caar y) '%log))) + (push y notlogs) + (push (cadr y) log)))) + (t + (push (logcon arg) notlogs)))) + (cond + ((null log) + (subst0 (cons '(mplus) (nreverse notlogs)) e)) + (t + (let ((simplified-log (lgcsimp + (let (($ratfac t)) + (sratsimp (muln log t)))))) + (addn (cons simplified-log notlogs) t)))))) (defun lgctimes (e) (setq e (subst0 (cons '(mtimes) (mapcar 'logcon (cdr e))) e)) ----------------------------------------------------------------------- Summary of changes: src/comm2.lisp | 45 +++++++++++++++++++++++++++++++-------------- tests/rtest_log.mac | 4 ++++ 2 files changed, 35 insertions(+), 14 deletions(-) hooks/post-receive -- Maxima CAS |