Sindbad~EG File Manager

/* M. Beeson, for Mathpert */
/* 11.1.91 original date   */
/* 1.29.98 last modified   */

#include <assert.h>
#define POLYVAL_DLL
#include "globals.h"
#include "gcdsub.h"
#include "cancel.h"

static term exponent_gcd(term u, term v, term x);
static term gs_aux(term v, term x);
/*_______________________________________________________________________*/
MEXPORT_POLYVAL term get_gcdsub(term v, term x)

/* First remove any integer powers of x which are factors of v, or
if v is a fraction, which are factors of the num or denom.
Here roots are counted as fractional
powers.  Then return x raised to the naive_gcd of all exponents
of powers of x contained in the rest of v.  If no powers of x
are contained in the rest of v, return zero.
  Examples:  if v contains x^4 and x^6, return x^2.  If v contains
x^(1/2) and x^(1/3), return x^(1/6).
  However, if the powers 'removed' as factors of v involve a fractional
exponent, this power should also be thrown into the gcd calculation.
  Example:  sqrt(t) / (1 + root(3,t))  should yield u = t^(1/6).
*/

{  term temp, temp2, ans, left;
   unsigned short f = FUNCTOR(v);
   int flag = 0;
   if(ATOMIC(v))
      return zero;
   if(INEQUALITY(f) && ISATOM(x))
      { /* block certain useless substitutions, e.g. in 1/x^n = a don't
           substitute w = 1/x or 1/x^n  */
        if(!contains(ARG(1,v),FUNCTOR(x)))
           { left = ARG(0,v);
             flag = 1;
           }
        else if(!contains(ARG(0,v),FUNCTOR(x)))
           { left = ARG(1,v);
             flag = 2;
           }
        if(flag && (FRACTION(left) || FUNCTOR(left) == '*'))
           /* also in 5x^(1/3) = 1, don't substitute u = x^(1/3) */
           { term num = ARG(0,left);
             term denom = ARG(1,left);
             if(!contains(num,FUNCTOR(x)) &&
                (ISATOM(denom) || (FUNCTOR(denom) == '^' && ISATOM(ARG(0,denom)) && !contains(ARG(1,denom),FUNCTOR(x))))
               )
                return zero;
           }
      }
   if(FUNCTOR(v) == '/')
       { temp = get_gcdsub(ARG(0,v),x);
         temp2 = get_gcdsub(ARG(1,v),x);
         if(ZERO(temp) || ONE(temp))
            return temp2;
         if(ZERO(temp2) || ONE(temp2))
            return temp;
         if(equals(temp,temp2))
            ans = temp;
         else
            ans = exponent_gcd(temp,temp2,x);
       }
   else
      ans = gs_aux(remove_powers(v,x),x);
   /* If ans = x^(1/2) maybe it should be sqrt(x) instead */
   if(FUNCTOR(ans) == '^' && FUNCTOR(ARG(1,ans))=='/' &&
      ONE(ARG(0,ARG(1,ans))) && equals(ARG(1,ARG(1,ans)),two)
      && contains(v,SQRT)
     )
      ans = sqrt1(x);
   return ans;
}
/*_______________________________________________________________*/
MEXPORT_POLYVAL term remove_powers(term t,term x)
/* return t with all integer powers of x that are factors of t removed;
or if t is a fraction, remove integer powers of x in numerator and denom;
This function also deletes factors that don't contain x at all.  */

{  int i;
   unsigned short n,k;
   unsigned short f = FUNCTOR(t);
   term u,ans,temp;
   if(ATOMIC(t))
      return one;
   if(f == '/')
      return make_fraction(remove_powers(ARG(0,t),x),remove_powers(ARG(1,t),x));
   if(f != '*')
      return t;
   n = ARITY(t);
   ans = make_term('*',n);
   k=0;
   for(i=0;i<n;i++)
      { u = ARG(i,t);
        if(!contains(u,FUNCTOR(x)))
           continue;
        if(equals(t,x))
           continue;
        f = FUNCTOR(u);
        if(f=='^' && INTEGERP(ARG(1,u)))
           continue;
        ARGREP(ans,k,u);
        ++k;
      }
  if(k==0)
      { RELEASE(ans);
        return one;
      }
  if(k==1)
      { temp = ARG(0,ans);
        RELEASE(ans);
        return temp;
      }
  SETFUNCTOR(ans,'*',k);
  return ans;
}
/*_______________________________________________________________*/
static term exponent_gcd(term u, term v, term x)
/* if u = x^a and v = x^b are powers of the same base x, return
x^gcd(a,b), where the gcd is naive_gcd; but if both a and b
are negative, return x^-gcd(a,b) instead.
x counts as x^1.  If one of u,v is a power of x but the other
is not, return the one that is.  Return zero if neither is.
   Also works on SQRT terms, treating them as fractional powers.
*/

{ term a,b,c;
  if(equals(u,x))
     a = one;
  else if(FUNCTOR(u) == '^' && equals(ARG(0,u),x))
     a = ARG(1,u);
  else if(FUNCTOR(u) == SQRT && equals(ARG(0,u),x))
     a = reciprocal(two);
  else if(FUNCTOR(u) == ROOT && equals(ARG(1,u),x))
     a = reciprocal(ARG(0,u));
  else
     SETFUNCTOR(a,ILLEGAL,0);
  if(equals(v,x))
     b = one;
  else if(FUNCTOR(v) == '^' && equals(ARG(0,v),x))
     b = ARG(1,v);
  else
     SETFUNCTOR(b,ILLEGAL,0);
  if(FUNCTOR(a) == ILLEGAL && FUNCTOR(b) == ILLEGAL)
     return zero;
  if(FUNCTOR(a) == ILLEGAL)
     return v;
  if(FUNCTOR(b) == ILLEGAL)
     return u;
  if(NEGATIVE(a) && NEGATIVE(b))
     { naive_gcd(ARG(0,a),ARG(0,b),&c);
       return make_power(x,tnegate(c));
     }
  naive_gcd(a,b,&c);
  return make_power(x,c);
}
/*_______________________________________________________________*/
static term gs_aux(term v, term x)
/* Return the exponent_gcd of all powers of x contained in v,
counting roots and square roots as fractional powers */
{  int i,err;
   unsigned short n;
   unsigned short f;
   term temp,ans,temp2,index,cancelled;
   if(equals(v,x))
      return x;
   else if(ATOMIC(v))
      return zero;
   f = FUNCTOR(v);
   n = ARITY(v);
   if(
      (f==SQRT  && equals(ARG(0,v),x)) ||
      (f==ROOT  && equals(ARG(1,v),x))
     )
      { if(f == SQRT)
           { index = two;
             temp = gs_aux(ARG(0,v),x);
           }
        else
           { index = ARG(0,v);
             temp = gs_aux(ARG(1,v),x);
           }
        if(equals(temp,x))
           return make_power(x,make_fraction(one,index));
        if(ZERO(temp) || ONE(temp))
           return zero;
        assert(FUNCTOR(temp) == '^' && equals(ARG(0,temp),x));
        err = cancel(ARG(1,temp),index,&cancelled,&temp2);
        if(err)
           temp2 = make_fraction(ARG(1,temp),index);
        return make_power(x,temp2);
      }
   if(f == '^' && equals(ARG(0,v),x))
      return v;
   ans = zero;
   for(i=0;i<n;i++)
      { temp2 = gs_aux(ARG(i,v),x);
        if(ZERO(ans) && ZERO(temp2))
           continue;
        if(ZERO(ans))
           ans = temp2;
        else if(! ZERO(temp2))
           { temp = exponent_gcd(ans,temp2,x);
             ans = temp;
           }
      }
   return ans;
}