Work at SourceForge, help us to make it a better place! We have an immediate need for a Support Technician in our San Francisco or Denver office.
Close
From: Rupert Swarbrick <rswarbrick@us...>  20130702 11:33:23

This is an automated email from the git hooks/postreceive 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 cd26b0225cfcf7ebf079a461ebfe1dd2d06aa6e3 (commit) via ab681cb18c60464c65e9d91df2bb0ae18e24aae2 (commit) from 867b2548c6ac1f46d024730599ae53eb76d8985d (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 cd26b0225cfcf7ebf079a461ebfe1dd2d06aa6e3 Author: Rupert Swarbrick <rswarbrick@...> Date: Tue Jul 2 12:28:34 2013 +0100 Fix bug in trigreduce with complicated expressions This fixes bug 2594. In particular, if you define testit(a, n) := block([initial: product(cos(k*x), k, 1, n)], [subst(a, x, initial), subst(a, x, trigreduce(initial))])$ then testit(0,k) gave the right answer for k=1,...,7, but gave something silly for k=8. It turns out that there was a logic error in sp1tplus. That function calls sp1sintcos repeatedly and gets back either a term of the form sin(foo) or cos(foo) or it gets a sum of such terms. In the latter case, if it started with a coefficient on the front, it might end up multiplying the coefficient by the sum. Unfortunately, this meant that on the next time round, the term wasn't in the right form and sp1sintcos started giving silly answers. The new code is much more paranoid and explicitly throws an error if it gets a result in a form that it doesn't recognise. diff git a/src/trgred.lisp b/src/trgred.lisp index bb0a4df..43ee637 100644  a/src/trgred.lisp +++ b/src/trgred.lisp @@ 174,21 +174,76 @@ (sp1tlin1 (rplacd l (cddr l)))) ((sp1tlin1 (cdr l))))) +;; Rewrite a product of sines and cosines as a sum +;; +;; L is a list of sines and cosines. For example, consider the list +;; +;; sin(x), sin(2*x), sin(3*x) +;; +;; This represents the product sin(x)*sin(2*x)*sin(3*x). +;; +;; ANS starts as sin(x). Then for each term in the rest of the list, we multiply +;; the answer that we have found so far by that term. The result will be a sum +;; of sines. In this example, sin(x)*sin(2*x) gives us +;; +;; 1/2 * (cos(x)  cos(3*x)) +;; +;; In fact we don't calculate the 1/2 coefficient in sp1sintcos: you always get +;; a factor of 2^(k1), where k is the length of the list, so this is calculated +;; at the bottom of sp1tplus. Anyway, next we calculate cos(x)*sin(3*x) and +;; cos(3*x)*sin(3*x) and sum the answers. Note that cos(3*x) will crop up +;; represented as ((mtimes) 1 ((%cos) ((mtimes) 3 $x))). See note in the let +;; form for info on what form ANS must take. (defun sp1tplus (l *trig)  (cond ((or (null l) (null (cdr l))) l)  ((do ((c (list '(rat) 1 (expt 2 (1 (length l)))))  (ans (list (car l)))  (l (cdr l) (cdr l)))  ((null l) (list c (m+l ans)))  (setq ans  (m+l  (mapcar #'(lambda (q)  (cond ((mtimesp q)  (m* (cadr q) (sp1sintcos (caddr q) (car l))))  ((sp1sintcos q (car l)))))  ans)))  (setq ans (if (mplusp ans) (cdr ans) (ncons ans)))))))  + (if (or (null l) (null (cdr l))) + l + ;; ANS is a list containing the terms in a sum for the expanded + ;; expression. Each element in this list is either of the form sc(x), + ;; where sc is sin or cos, or of the form ((mtimes) coeff ((sc) $x)), + ;; where coeff is some coefficient. + ;; + ;; multiplyscterms rewrites a*sc as a sum of sines and cosines. The + ;; result is a list containing the terms in a sum which is + ;; mathematically equal to a*sc. Assuming that term is of one of the + ;; forms described for ANS below and that SC is of the form sc(x), the + ;; elements of the resulting list will all be of suitable form for + ;; inclusion into ANS. + (flet ((multiplyscterms (term sc) + (let* ((coefficient (when (mtimesp term) (cadr term))) + (termsc (if (mtimesp term) (caddr term) term)) + (expanded (sp1sintcos termsc sc))) + ;; expanded will now either be sin(foo) or cos(foo) OR it + ;; will be a sum of such terms. + (cond + ((not coefficient) (list expanded)) + ((or (atom expanded) + (member (caar expanded) '(%sin %cos %sinh %cosh) + :test 'eq)) + (list (m* coefficient expanded))) + ((mplusp expanded) + (mapcar (lambda (summand) (m* coefficient summand)) + (cdr expanded))) + (t + (error "Unrecognised output from sp1sintcos."))))) + ;; Treat EXPR as a sum and return a list of its terms + (termsofsum (expr) + (if (mplusp expr) (cdr expr) (ncons expr)))) + + (let ((ans (list (first l)))) + (dolist (sc (rest l)) + (setq ans (termsofsum + (m+l (mapcan (lambda (q) + (multiplyscterms q sc)) ans))))) + (list (list '(rat) 1 (expt 2 (1 (length l)))) + (m+l ans)))))) + +;; The core of trigreduce. Performs transformations like sin(x)*cos(x) => +;; sin(2*x) +;; +;; This function only does something nontrivial if both a and b have one of +;; sin, cos, sinh and cosh as toplevel operators. (Note the first term in the +;; cond: we assume that if a,b are nonatomic and not both of them are +;; hyperbolic/trigonometric then we can just multiply the two terms) (defun sp1sintcos (a b) (let* ((x nil) (y nil)) diff git a/tests/rtest16.mac b/tests/rtest16.mac index 62405d1..480b691 100644  a/tests/rtest16.mac +++ b/tests/rtest16.mac @@ 1856,3 +1856,7 @@ block([domain : 'real], integrate(x^(8*%i1),x)); /* #2602: somebfloatp and somefloatp recursed wrongly on rat expressions */ ?some\bfloatp(rat(1/2)); false$ + +/* #2594: Error in trigreduce for complicated expressions */ +subst(0, x, trigreduce(product(cos(k*x), k, 1, 8))); +1$ commit ab681cb18c60464c65e9d91df2bb0ae18e24aae2 Author: Rupert Swarbrick <rswarbrick@...> Date: Tue Jul 2 00:24:28 2013 +0100 Rewrite some of sp1times using dotimes/push/mapc No change to functionality (provided the implementation was bright enough to spot that we were throwing away the result of a mapcar), but slightly easier to read. diff git a/src/trgred.lisp b/src/trgred.lisp index b5d7698..bb0a4df 100644  a/src/trgred.lisp +++ b/src/trgred.lisp @@ 127,18 +127,21 @@ (tr nil) (hyp nil) (*lin '(0)))  (do ((e (cdr e) (cdr e)))  ((null e) (setq g (mapcar #'sp1 g)))  (cond ((or (mnump (car e))  (and (not (eq var '*novar)) (free (car e) var)))  (setq fr (cons (car e) fr)))  ((atom (car e)) (setq g (cons (car e) g)))  ((or (trigfp (car e))  (and (eq (caaar e) 'mexpt) (trigfp (cadar e))))  (sp1add (car e)))  ((setq g (cons (car e) g)))))  (mapcar #'(lambda (q) (sp1sincos q t)) *trigbuckets*)  (mapcar #'(lambda (q) (sp1sincos q nil)) *hyperbuckets*) + (dolist (factor (cdr e)) + (cond ((or (mnump factor) + (and (not (eq var '*novar)) (free factor var))) + (push factor fr)) + ((atom factor) (push factor g)) + ((or (trigfp factor) + (and (eq (caar factor) 'mexpt) + (trigfp (cadr factor)))) + (sp1add factor)) + (t + (push factor g)))) + (setq g (mapcar #'sp1 g)) + + (mapc #'(lambda (q) (sp1sincos q t)) *trigbuckets*) + (mapc #'(lambda (q) (sp1sincos q nil)) *hyperbuckets*) (setq fr (cons (m^ (1//2) (m+l *lin)) fr) *lin nil) (setq tr (cons '* (mapcan #'sp1untrep *trigbuckets*)))  Summary of changes: src/trgred.lisp  108 ++++++++++++++++++++++++++++++++++++++++ tests/rtest16.mac  4 ++ 2 files changed, 87 insertions(+), 25 deletions() hooks/postreceive  Maxima CAS 