Sindbad~EG File Manager

/* M. Beeson, for Mathpert */
/*
7.11.94, moved this ancient code to its own file
1.29.98 last modified
*/

#include <assert.h>
#include <stdlib.h>   /* qsort */
#define POLYVAL_DLL
#include "globals.h"  /* which includes setjmp.h and terms.h */
#include "cancel.h"
#include "pvalaux.h"
#include "order.h"     /* atomorder */
static int atomcompare(const void *x, const void *y);
/*_______________________________________________________________*/
MEXPORT_POLYVAL int is_linear(term t)
/* check if t is a linear term; zero return means it is */
/* this is called by is_linear_system, below */
/* and is also called in chkinput.c          */
{ int err;
  int n,i;
  term u;
  if(FUNCTOR(t) == '+') /* a sum is linear if all its summands are linear */
     { n = ARITY(t);
       for(i=0;i<n;i++)
           { err = is_linear(ARG(i,t));
             if(err)
                return 1;
           }
       return 0;
     }
  if(FUNCTOR(t) == '-')
     return is_linear(ARG(0,t));
  if(ATOMIC(t))
     return 0;   /* an atom or number is linear */
  if(constant(t))
     return 0;   /* any constant is linear */
  if(FUNCTOR(t) == '/')
    { if(constant(ARG(1,t)))  /* linear numerator, constant denom is ok */
         return is_linear(ARG(0,t));
      else
         return 1;
    }
  if(FUNCTOR(t) == '^')
     { if(ONE(ARG(1,t)))    /* x^1 is linear; x^0 isn't */
          return is_linear(ARG(0,t));
       else
          return 1;
     }
  if(FUNCTOR(t) == '*')
     { n = ARITY(t);
       err = 0;
       for(i=0;i<n;i++)
          { u = ARG(i,t);
            if(is_linear(u))  /* remember is_linear returns non-zero for error */
               return 1;
            if(!constant(u))
               { if(err)
                    return 1;  /* second non-constant factor */
                 err =1;
               }
          }
       return 0;  /* at most one non-constant factor, and that one linear */
     }
   return 1;   /* no other functors legal */
}
/*_______________________________________________________________*/
MEXPORT_POLYVAL int is_linear_system(term t, int linenumber, term *vlist)
/* called from getprob.c to test input.  (User gets a chance in getprob.c
to name some variables parameters to make it pass this test.)  It's also
called in show2d to see whether to make a LINEARSYSTEMS term so that
a linear system can be displayed with variables lined up, and
similarly in lterm.c  */
/* Zero return means it passed, it is a linear system */
/* A linear system in ONE variable is considered legal here. */
/* In case of success, *vlist is used to return an AND term which is a
list of all the variables used in this linear system.  Parameters
are not included. */
/* t is supposed to already be checked to be an AND term; the arguments
of t may be equations, but if they aren't, enhance_problem is going to
set them equal to zero, so they don't HAVE to be equations when this
function is called. */
/* temp is return as an AND of variables; space for the args is
made here. */

{ int k = ARITY(t);  /* number of equations */
  int i,err,index;
  unsigned short natoms;
  term u,temp;
  term *atomlist;
  parameter *parameters;
  assert(FUNCTOR(t)==AND);
  for(i=0;i<k;i++)
     { u = ARG(i,t);
       if(FUNCTOR(u) == '=')
          { err = is_linear(ARG(0,u));
            if(err)
               return 1;
            err = is_linear(ARG(1,u));
            if(err)
               return 1;
          }
       else
          { err = is_linear(u);
            if(err)
               return 1;
          }
     }
   /* Now determine the variables involved */
   natoms = variablesin(t,&atomlist);
   temp = make_term(AND,natoms);
   parameters = get_parameters();
   k = 0;
   for(i=0;i<natoms;i++)
      { index = isparameter(atomlist[i]);
        if(index >= 0 && parameters[index].linenumber <= linenumber)
           continue;  /* don't count this atom, it's a parameter */
        /* We check when it became a parameter; the user can use
           regardvarasconst to make a variable a parameter, but we
           still call this function to paint earlier lines and
           they need to use the variables that were not parameters
           at that point. */
        ARGREP(temp,k,atomlist[i]);
        ++k;
      }
   SETFUNCTOR(temp,AND,k);
   if(k > 1)
      sortatoms(ARGPTR(temp), ARITY(temp));
   *vlist = temp;
   free2(atomlist);
   return 0;
}
/*__________________________________________________________*/

static int atomcompare(const void *x, const void *y)
/* used by qsort to sort atoms */
{ term a,b;
  unsigned f,g;
  a = * (term *) x;
  b = * (term *) y;
  f = FUNCTOR(a);
  g = FUNCTOR(b);
  return atomorder(f,g);
}
/*____________________________________________________________________*/
MEXPORT_POLYVAL int islinear(term t, term x, term *a, term *b)
/* return 1 if t is of the form ax +b, or x+b, or ax, or x, or -x, or -ax,
instantiating a and b; match both orders of the summands.
Of course a and b must not contain x.  Note that b can be a sum
such as 2 + sqrt 2, so t can be a sum of arity 3 or more.
Return zero if not of this form.  Returns 0 on ax + bx + c;
there must be just ONE term containing x.
*/

{ term u,v,cancelled;
  int err,flag;
  int sign = 1;
  unsigned short i,n;
  if(equals(t,x))
     { *a = one;
       *b= zero;
       return 1;
     }
  if(ISATOM(t))
     return 0;
  if(OBJECT(t))
     { *a = zero;
       *b = t;
       return 1;
     }
  if(NEGATIVE(t))
     { u = ARG(0,t);
       if(equals(u,x))
          { *a = minusone;
            *b = zero;
            return 1;
          }
       if(FUNCTOR(u) == '*')
          { if(!islinear(u,x,a,b))
               return 0;
            assert(ZERO(*b));
            *a = tnegate(*a);
            return 1;
          }
     }
  if(FUNCTOR(t) == '*')
      { if(ARITY(t)==2 && equals(ARG(1,t),x) && !contains(ARG(0,t),FUNCTOR(x)))
           { *b = zero;
             *a = ARG(0,t);
             return 1;
           }
               /* this avoids calling cancel in common cases */
        err = cancel(t,x,&cancelled,a);
        if(!err &&  !contains(*a,FUNCTOR(x)) && equals(x,cancelled))
           { *b = zero;
             return 1;
           }
        return 0;  /* failure */
      }
  if(FUNCTOR(t) == '+')
      { n = ARITY(t);
        flag = 0;
        for(i=0;i<n;++i)
           { if(contains(ARG(i,t),FUNCTOR(x)))
                { if(flag)
                     return 0;
                  flag = i+1;
                }
           }
        if(!flag)     /* no term containing x found */
           return 0;  /* constants don't count as linear here */
        u = ARG(flag-1,t);
        if(n==2)
           v = ARG(flag == 1 ? 1 : 0, t);
        else
           { v = make_term('+', (unsigned short)(n-1));
             for(i=0;i<(unsigned)(n-1);i++)
                ARGREP(v,i,ARG(i+1 < flag ? i : i+1,t));
           }
        *b = v;
        if (FUNCTOR(u) == '-')
           { sign = -1;
             u = ARG(0,u);
           }
        if(equals(u,x))
            { *a = sign < 0 ? minusone : one;
              return 1;
            }
        else if (FUNCTOR(u) != '*')
           return 0; /* failure */
        else if(ARITY(u) == 2 && equals(ARG(1,u),x) && !contains(ARG(0,u),FUNCTOR(x)))
            { *a = ARG(0,u);
              if(sign < 0)
                 *a = tnegate(*a);
              return 1;
            }
            /* the above avoids calling cancel in common cases */
        err = cancel(u,x,&cancelled,a);
        if(!err && !contains(*a,FUNCTOR(x)) && equals(x,cancelled))
            { if(sign < 0)
                 *a = tnegate(*a);
              return 1;
            }
        return 0;
      }
  return 0;
}
/*______________________________________________________*/
MEXPORT_POLYVAL void sortatoms(term *data, unsigned n)
/* data is an array of n atoms.  Sort them (in place) */
{  qsort(data, n, sizeof(term), atomcompare);
}
/*______________________________________________________*/
MEXPORT_POLYVAL int is_linear_in(term t, term x)
/* return 1 if t is linear in x, 0 if not.  Compare to
islinear and is_linear (which won't accept non-linear constant terms)
in enhance.c.  Will accept a linear equation or inequality as well
as a linear function of x. */

{ unsigned f = FUNCTOR(t);
  unsigned i,n;
  term c,s;
  if(ATOMIC(t))
     return 1;
  if(f == '-')
     return is_linear_in(ARG(0,t),x);
  if(INEQUALITY(f))
     return is_linear_in(ARG(0,t),x) && is_linear_in(ARG(1,t),x);
  if(f == '+')
     { n = ARITY(t);
       for(i=0;i<n;i++)
          { if(!is_linear_in(ARG(i,t),x))
               return 0;
          }
        return 1;
     }
  if(f == '*' || f == '/')
     { twoparts(t,x,&c,&s);
       if(ATOMIC(s))
          return 1;
       if(FUNCTOR(s) == '+')
          return is_linear_in(s,x);
       /* if the input is 2(-2x) for example, we get here with s = -2x */
       if(!ONE(c))
          return is_linear_in(s,x);
       return 0;
     }
  if(!contains(t,FUNCTOR(x)))
     return 1;
  return 0;
}