Sindbad~EG File Manager

/* M. Beeson, for Mathpert */
/*
7.11.94, moved this ancient code to its own file
1.29.98  modified
5.5.13 added islinear.h
9.23.24  rewrote is_linear_system
9.25.24  modified is_linear_system
1.23.25  modified is_linear_system to use ARITY(*vlist) instead of N
*/

#include <assert.h>
#include <stdlib.h>   /* qsort */

#include "globals.h"  /* which includes setjmp.h and terms.h */
#include "cancel.h"
#include "pvalaux.h"
#include "order.h"     /* atomorder */
#include "islinear.h"  
static int atomcompare(const void *x, const void *y);
/*_______________________________________________________________*/
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 */
}
/*_______________________________________________________________*/
int is_linear_system(term t, int linenumber, term *vlist)
/* called from getprob.c to test input.  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, with
variables returned in *vlist as an AND of variables the same
arity (or smaller) arity as the AND term t, which let us call N. */
/* If there are at most N variables in t, that is easy, just
return them in vlist.  If there are more than N variables, then
see if there exactly N in the last half of the alphabet.
If so, make the rest parameters (remember some might be Greek)
and return 0.
   If there are more than N variables in the last half of the
alphabet, return 1--that's an error.
   If there are fewer than N in the last half of the alphabet,
as in [x-ab =12, x+b=4], that's also an error.  We would not know
whether the user wanted a or b to be a parameter.
   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.
   vlist is returned as an AND of variables; space for the args is
made here, and should be RELEASEd  after use.
   varlist must be changed so that it begins with vlist (on success).

*/

{ int N = ARITY(t);  /* number of equations */
  int i,err,index,k;
  unsigned short natoms;
  term u,temp;
  term *atomlist;
  parameter *parameters;
  assert(FUNCTOR(t)==AND);
   /* 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), k);
   if(k <= N)
     { *vlist = temp;
       free2(atomlist);
       goto out;
     }
   // how many of the variables are in the last half of the alphabet?
   int count = 0;
   unsigned f;
   for(i=0;i<k;i++)
      { f = FUNCTOR(ARG(i,temp));
        if( ('m' < f  && f <= 'z') || ('M' < f && f < 'Z'))
           ++count;
      }
   if(count != N)
      return 1;  // error
   *vlist = make_term(AND,N);
  // make the ones not in the last half into parameters
   int next = 0;
   for(i=0;i<k;i++)
      { f = FUNCTOR(ARG(i,temp));
        if( ('m' < f  && f <= 'z') || ('M' < f && f < 'Z'))
           { ARGREP(*vlist, next,ARG(i,temp));
             ++next;
             continue;
           }
        initialize_parameter(get_index(ARG(i,temp)),linenumber, 1.0);
      }
   SETFUNCTOR(*vlist,AND,next);
   RELEASE(temp);  // done with it!
   goto out;
   out:
     // Now check if the equations are linear!  That had to wait until we made
     // some of the variables into parameters, otherwise e.g. x-ay would not be linear.
   for(i=0;i<N;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 change varlist so it begins with vlist. */
   for(i=0;i<ARITY(*vlist);i++)
      { int k = get_index(ARG(i,*vlist));  // so varlist[k]= ARG(i,*vlist)
        if(i!= k)
           swapvars(i,k); // making varlist[i] = ARG(i,*vlist);
      }
   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);
}
/*____________________________________________________________________*/
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;
}
/*______________________________________________________*/
void sortatoms(term *data, unsigned n)
/* data is an array of n atoms.  Sort them (in place) */
{  qsort(data, n, sizeof(term), atomcompare);
}
/*______________________________________________________*/
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.
   Accepts for example  x-ay  as linear in y,  even if a is not a parameter.
*/

{ 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;
}