Further code to improve the assume database



Am Samstag, den 10.10.2009, 20:06 +0200 schrieb Dieter Kaiser:
> Am Samstag, den 10.10.2009, 12:35 -0500 schrieb Barton Willis:
> > -----maxima-bounces at math.utexas.edu wrote: -----
> > 
> > 
> > >I have no problems with the testsuite and the share_testsuite with the
> > >exception of one example:
> > >
> > >********************** Problem 40 ***************
> > >Input:
> > >fourier_elim(fourier_elim(eqs, [y, x, z]), [z, y, x])
> > >
> > >
> > >Result:
> > >[0 < z, z < min(4, - y - x + 4), 0 < y, y < 1, 0 < x, x < 1]
> > >
> > >This differed from the expected result:
> > >[0 < z, z < 4 - x - y, 0 < y, y < 1, 0 < x, x < 1]
> > 
> > The new result isn't wrong, but the old answer is better, isn't it? Since
> > 0 < x < 1 and 0 < y < 1, we have -y - x + 4 < 4. So min(4, - y - x + 4)
> > should simplify to -y - x + 4. There is a source code comment in
> > Fourier elimination code: (What is the story with dosimp?)
> 
> Hello Barton,
> 
> thank you for the answer.
> 
> I will try to find the reason why we get a difference only for this
> example.

I have got the error. The routine sign-shift was wrong. Now the
testsuite and the share_testsuite run without a failure.

This is a correct version:

(defun sign-shift (expr)
  (do ((l (append (cdr (facts1 '$learndata)) (cdr (facts1 $context)))
(cdr l))
       (e expr)
       (flag) (fact) (num))
      ((null l)
       (if flag ($expand e) expr))
    (setq fact (car l))
    (cond ((and (eq (caar fact) 'mgreaterp)
               (symbolp (cadr fact))
               (not ($freeof (cadr fact) e))
               (not (member (cadr fact) '($%pi $%e $%gamma $%phi)))
               (mnump (setq num (caddr fact)))
               (eq ($sign num) '$pos))
           ;; symbol > positive number
           (setq flag t)
           (setq e (maxima-substitute (add (cadr fact) num) (cadr fact)
e)))
          ((and (eq (caar fact) 'mgreaterp)
                (symbolp (caddr fact))
                (not ($freeof (caddr fact) e))
                (not (member (caddr fact) '($%pi $%e $%gamma $%phi)))
                (mnump (setq num (cadr fact)))
                (eq ($sign num) '$neg))
           ;; negative number > symbol
           (setq flag t)
           (setq e 
                 (maxima-substitute (add (caddr fact) num) (caddr fact)
e))))))

Dieter Kaiser