Sindbad~EG File Manager

/* M. Beeson, for Mathpert
   Original date 5.19.96
   previously modified 6.5.95
   Last modified 1.29.98
*/

#define POLYVAL_DLL
#include "globals.h"
#include "probtype.h"
#include "prover.h"
#include "deval.h"
#include "boole.h"

static term reverse(term t);
/*_____________________________________________________________*/
static int combine2intervals(term u, term v, term *ans)
/* if u and v are intervals whose union is an interval,
put that union in *ans, returning 0. Otherwise return 1
(*ans can be garbage)
*/
{ unsigned short f = FUNCTOR(u);
  unsigned short g = FUNCTOR(v);
  term a,b,c,d,x;
  double za,zb,zc,zd;
  term temp;
  int err;

  if((f == '>' || f == GE) && (g == '>' || g == GE))
     { err = combine2intervals(reverse(u),reverse(v),&temp);
       if(err)
          return 1;
       *ans = reverse(temp);
       return 0;
     }
  if(f == '>' || f == GE)
     return combine2intervals(reverse(u),v,ans);
  if(g == '>' || g == GE)
     return combine2intervals(u,reverse(v),ans);
  /* first the case of combining two intervals with infinite endpoints */
  if((f == '<' || f == LE) && (g == '<' || g == LE))
     { /* a < x | b < x  => min(a,b) < x */
       a = ARG(0,u);
       b = ARG(0,v);
       if(equals(ARG(1,u),ARG(1,v)) &&
          seminumerical(a) && seminumerical(b)
         )
          { deval(a,&za);
            deval(b,&zb);
            if(za != BADVAL && zb != BADVAL)
               { if(za < zb)
                    *ans = f == '<' ? lessthan(a,ARG(1,u)) : le(a,ARG(1,u));
                 else if(zb < za)
                    *ans = g == '<' ? lessthan(b,ARG(1,u)) : le(b,ARG(1,u));
                 else
                    *ans = (f == LE || g == LE) ? le(a,ARG(1,u)) : lessthan(a,ARG(1,u));
                 return 0;
               }
            return 1;
          }
       /* x < a | x < b => x < max(a,b)  */
       a = ARG(1,u);
       b = ARG(1,v);
       if(equals(ARG(0,u),ARG(0,v)) &&
          seminumerical(a) && seminumerical(b)
         )
          { deval(a,&za);
            deval(b,&zb);
            if(za!= BADVAL && zb != BADVAL)
               { if(za < zb)
                    *ans = f == '<' ? lessthan(ARG(0,u),b) : le(ARG(0,u),b);
                 else if(zb < za)
                    *ans = g == '<' ? lessthan(ARG(0,u),a) : le(ARG(0,u),a);
                 else /* za == zb  */
                    *ans = (f == LE || g == LE) ? le(ARG(0,u),a) : lessthan(ARG(0,u),a);
                 return 0;
               }
            return 1;
          }
       /* a < x | x < b => true if a < b */
       if(equals(ARG(1,u),ARG(0,v)))
          { a = ARG(0,u);
            b = ARG(1,v);
            if(!seminumerical(a) || !seminumerical(b))
               return 1;
            deval(a,&za);
            deval(b,&zb);
            if(za == BADVAL || zb == BADVAL)
               return 1;
            if(za < zb || (za == zb && (f == LE || g == LE)))
               { *ans = true;
                 return 0;
               }
          }
       if(equals(ARG(1,v),ARG(0,u)))
          { a = ARG(0,v);
            b = ARG(1,u);
            if(!seminumerical(a) && !seminumerical(b))
               return 1;
            deval(a,&za);
            deval(b,&zb);
            if(za == BADVAL || zb == BADVAL)
               return 1;
            if(za < zb || (za==zb && (f == LE || g == LE)))
               { *ans = true;
                 return 0;
               }
          }
     }
  /* Now the case of a finite interval combined with a semi-infinite interval */
  if(g == AND && (f == '<' || f == LE))
     return combine2intervals(v,u,ans);
  if(f == AND && (g == '<' || g == LE))
     { if(!interval_as_and(u))
          return 1;
       a = ARG(0,ARG(0,u));
       b = ARG(1,ARG(1,u));
       if(!seminumerical(a) || !seminumerical(b))
          return 1;
       x = ARG(1,ARG(0,u));
       deval(a,&za);
       deval(b,&zb);
       if(za==BADVAL || zb == BADVAL)
          return 1;
       if(za >= zb)
          return 1; /* should never happen, but why risk assert(0)? */
       if(equals(ARG(1,v),x)) /* semi-infinite on the right */
          { c = ARG(0,v);
            if(!seminumerical(c))
               return 1;
            deval(c,&zc);
            if(zc == BADVAL)
               return 1;
            if(zc > zb )
              return 1;
            if(za > zc || (za==zc && (g == LE || FUNCTOR(ARG(0,u)) == '<')))
              { *ans = v;
                return 0;
              }
            if(za == zc) /* and FUNCTOR(ARG(0,u)) == LE and g == '<' */
              { *ans = le(c,x);
                return 0;
              }
            if(zb == zc && (FUNCTOR(ARG(1,u)) == '<' || g == '<'))
              return 1;
            *ans = FUNCTOR(ARG(0,u)) == '<' ? lessthan(a,x) : le(a,x);
            return 0;
          }
       if(equals(ARG(0,v),x))  /* semi-infinite on the left */
          { d = ARG(1,v);
            if(!seminumerical(d))
               return 1;
            deval(d,&zd);
            if(zd == BADVAL)
               return 1;
            if(zd < za)
               return 1;
            if(zb < zd || zb == zd && (g == LE || FUNCTOR(ARG(1,u)) == '<'))
               { *ans = v;
                 return 0;
               }
            if(zb == zd)
               { *ans = le(x,d);
                 return 0;
               }
            if(za == zd && (FUNCTOR(ARG(0,u)) == '<' || g == '<'))
               return 1;
            *ans = FUNCTOR(ARG(1,u)) == '<' ? lessthan(x,b) : le(x,b);
            return 0;
          }
     }
  /* Now the case of two finite intervals */
  if(!interval_as_and(u) || !interval_as_and(v))
     return 1;
  a = ARG(0,ARG(0,u));
  b = ARG(1,ARG(1,u));
  x = ARG(1,ARG(0,u));
  c = ARG(0,ARG(0,v));
  if(!equals(x,ARG(1,ARG(0,v))))
     return 1;
  d = ARG(1,ARG(1,v));
  if(!seminumerical(a) || !seminumerical(b) || !seminumerical(c) || !seminumerical(d))
     return 1;
  deval(a,&za);
  deval(b,&zb);
  deval(c,&zc);
  deval(d,&zd);
  if(za == BADVAL || zb == BADVAL || zc == BADVAL || zd == BADVAL)
     return 1;
  if(za >= zb || zc >= zd)
     return 1;  /* illegal intervals as input */


  /* First, the cases where one interval contains the interior of the other */
  if(za < zc && zd < zb)  /* v is a subset of u */
     { *ans = u;
       return 0;
     }
  if(zc < za && zb < zd)  /* u is a subset of v */
     { *ans = v;
       return 0;
     }
  if(za == zc && zb == zd)  /* both endpoints coincide */
     { *ans = make_term(AND,2);
       if(FUNCTOR(ARG(0,u)) == LE || FUNCTOR(ARG(0,v)) == LE)
          ARGREP(*ans,0,le(a,x));
       else
          ARGREP(*ans,0,lessthan(a,x));
       if(FUNCTOR(ARG(1,u)) == LE || FUNCTOR(ARG(1,v)) == LE)
          ARGREP(*ans,1,le(x,b));
       else
          ARGREP(*ans,1,lessthan(x,b));
       return 0;
     }
  if(za == zc && zb < zd)
     { *ans = make_term(AND,2);
       if(FUNCTOR(ARG(0,u)) == LE || FUNCTOR(ARG(0,v)) == LE)
          ARGREP(*ans,0,le(a,x));
       else
          ARGREP(*ans,0,lessthan(a,x));
       ARGREP(*ans,1,ARG(1,v));
       return 0;
     }
  if(za == zc && zd < zb)
     { *ans = make_term(AND,2);
       if(FUNCTOR(ARG(0,u)) == LE || FUNCTOR(ARG(0,v)) == LE)
          ARGREP(*ans,0,le(a,x));
       else
          ARGREP(*ans,0,lessthan(a,x));
       ARGREP(*ans,1,ARG(1,u));
       return 0;
     }
  if(za < zc && zb == zd)
     { *ans = make_term(AND,2);
       ARGREP(*ans,0,ARG(0,u));
       if(FUNCTOR(ARG(1,u)) == LE || FUNCTOR(ARG(1,v)) == LE)
          ARGREP(*ans,1,le(x,b));
       else
          ARGREP(*ans,1,lessthan(x,b));
       return 0;
     }
  if(zc < za && zb == zd)
     { *ans = make_term(AND,2);
       ARGREP(*ans,0,ARG(0,v));
       if(FUNCTOR(ARG(1,u)) == LE ||  FUNCTOR(ARG(1,v)) == LE)
          ARGREP(*ans,1,le(x,b));
       else
          ARGREP(*ans,1,lessthan(x,b));
       return 0;
     }
  /* Now for the case of two overlapping finite intervals */
  if(za < zc && zc < zb && zb < zd)
     { *ans = and(ARG(0,u),ARG(1,v));
       return 0;
     }
  if(zc < za && za < zd && zd < zb)
     { *ans = and(ARG(0,v),ARG(1,u));
        return 0;
     }
  if(FUNCTOR(ARG(1,u)) == LE && FUNCTOR(ARG(0,v)) == LE && equals(b,c))
     { *ans = and(le(a,x),le(ARG(1,ARG(0,v)),d));
        /* use ARG(1,ARG(0,v)) instead of a second copy of x to avoid a DAG */
       return 0;
     }
  if(FUNCTOR(ARG(1,v)) == LE && FUNCTOR(ARG(0,u)) == LE && equals(a,d))
     { *ans = and(le(c,x),le(ARG(1,ARG(0,v)),b));
       return 0;
     }
  return 1;
}

/*______________________________________________________________________*/
MEXPORT_POLYVAL int union_intervals(term t, term *next)
/* if t is an OR of intervals, and the union of some pair of
these intervals is an interval, succeed, returning the union in
*next. Return 0 for success, 1 for failure.  There are several
possibilities as intervals can be of the forms a < x,
a<x<b, x < a, etc with LE instead of < in one or both positions.
It only works if the necessary values min(a,b) etc can be computed
because a and b are numbers.
*/
{ unsigned short n;
  term u;
  int i,j,k,err;
  n = ARITY(t);
  for(i=0;i<n;i++)
     { for(j=i+1;j<n;j++)
          { err = combine2intervals(ARG(i,t),ARG(j,t),&u);
            if(!err)
                { /* replace ARG(i,t) by u, drop ARG(j,t), and succeed */
                  if(n == 2)
                     { *next = u;
                       return 0;
                     }
                  *next = make_term(OR,(unsigned short)(n-1));
                  for(k=0;k<n-1;k++)
                     ARGREP(*next,k,k<i ? ARG(k,t): k==i ? u : k<j ? ARG(k,t) : ARG(k+1,t));
                  return 0;
                }
          }
     }
  return 1;
}

/*__________________________________________________________________*/
int TarskiBoole(term t, term *ans)
/*  Boolean combinations of intervals are reduced by  'TarskiBoole'
to disjunctions of intervals.  However, the input is not presumed
to be a boolean combination of intervals, but of arbitrary inequalities,
in which however existential variables do not occur in negative subformulae.
In case of this more general input the reduction will be to DNF.

This is used after explicitdomain, which returns a conjunction of the
current line with the assumptions that are not implied by the current line.
For example consider f(x)/f(x) > 0, the
answer is the codomain of f(x), which can be pretty complicated,
even infinite, e.g. sin(x)/sin(x) > 0, the answer is
n pi < x < (n+1)pi, a parametrized union of infinitely many intervals.
So TarskiBoole can't be guaranteed to succeed. We might get some
messy answers, too bad.
*/
{ *ans = t;
  return 1;  /* FINISH THIS */
}

/*_______________________________________________________________________*/
static term reverse(term t)
/* if t is an inequality, return an equivalent equality with < changed to >,
etc. */

{ term a,b;
  unsigned short f = FUNCTOR(t);
  if(f != '<' && f != LE && f != '>' && f != GE)
     return t;
  a = ARG(0,t);
  b = ARG(1,t);
  switch(f)
     { case '<' :  return greaterthan(b,a);
       case '>' :  return lessthan(b,a);
       case LE  :  return ge(b,a);
       case GE  :  return le(b,a);
     }
  return t;  /* can't get here, but avoid a warning message */
}