Sindbad~EG File Manager

Current Path : /usr/home/beeson/Otter-Lambda/yyy/algebra/
Upload File :
Current File : /usr/home/beeson/Otter-Lambda/yyy/algebra/sqrtfrac.c

/* MathXpert operators for fractions involving roots, sqrts, abs */
/*  M. Beeson
12.24.90  Original date
2.26.98 last modified
*/

#define ALGEBRA_DLL
#include <string.h>
#include <assert.h>
#include "globals.h"
#include "ops.h"
#include "cancel.h"
#include "polynoms.h"
#include "algaux.h"
#include "order.h"    /* sortargs      */
#include "pvalaux.h"    /* contains_sqrt */
#include "autosimp.h" /* get_pathtail  */
#include "pathtail.h"
#include "pvalaux.h"
#include "prover.h"

static int sqrtgcd_aux(unsigned short f, term t, term arg, term *next, char *reason);


/*_______________________________________________________________________*/
MEXPORT_ALGEBRA int cancel_roots(term t, term *next)
/* ��(xy)/��y = �x */
/* ��(xy)/��(yz) = ��x/��z */
{ int i,j,err;
  unsigned short n,fnum,fden;
  term num, denom,u,v,w,temp,cancelled,p,index;
  if(FUNCTOR(t) != '/')
      return 1;
  num = ARG(0,t);
  denom = ARG(1,t);
  fnum = FUNCTOR(num);
  fden = FUNCTOR(denom);
  if(fnum == ROOT && fden == ROOT)
     { if(!equals(ARG(0,num),ARG(0,denom)))
           return 1;    /* indices must be the same */
       index = ARG(0,num);
       u = ARG(1,num);
       v = ARG(1,denom);
       err = cancel(u,v,&cancelled,&temp);
       if(err)
          return 1;
       /* cancelled must be positive or index must be odd */
       if(INTEGERP(index) && ISEVEN(index))
           { err = infer(lessthan(zero,cancelled));
             if(err)
                return 1;
           }
       /* If index is odd there's nothing to check */
       if(!INTEGERP(index))
           { err = infer(lessthan(cancelled,zero));
             if(err)
                 { err = infer(odd(index));
                   if(err)
                       return 1;
                 }
           }
       if(FRACTION(temp))
          *next = make_fraction(make_root(index,ARG(0,temp)),make_root(index,ARG(1,temp)));
       else
          *next = make_root(index,temp);
       return 0;
     }
  if(FUNCTOR(num) == '*' && (FUNCTOR(denom) == ROOT || FUNCTOR(denom) == '*'))
     { n = ARITY(num);
       for(i=0;i<n;i++)
          { w = ARG(i,num);
            if(FUNCTOR(w) != ROOT)
               continue;
            err = cancel_roots(make_fraction(w,denom),&temp);
            if(!err)
                break;
          }
       if(i==n)
          return 1;
       if(!FRACTION(temp))
          { p = make_term('*',n);
            for(j=0;j<n;j++)  /* so as not to alter the args of num */
               ARGREP(p,j, i==j ? temp : ARG(j,num));
            *next = topflatten(p);
          }
       else if(ONE(ARG(0,temp)) && n == 2)
          *next = make_fraction(ARG(i ? 0 : 1,num), ARG(1,temp));
       else if(ONE(ARG(0,temp)))
          { p = make_term('*',(unsigned short)(n-1));
            for(j=0;j<n-1;j++)
               ARGREP(p,j,j<i ? ARG(j,num) : ARG(j+1,num));
            *next = make_fraction(p,ARG(1,temp));
          }
       else
          { p = make_term('*',n);
            for(j=0;j<n;j++)
               ARGREP(p,j,i==j ? ARG(0,temp) : ARG(j,num));
            *next = make_fraction(topflatten(p),ARG(1,temp));
          }
       return 0;
     }
  if(FUNCTOR(denom) == '*' && FUNCTOR(num) == ROOT)
     { err= cancel_roots(make_fraction(denom,num),&temp);
       if(err)
          return 1;
       *next = reciprocal(temp);
       return 0;
     }
  return 1;
}
/*_______________________________________________________________________*/
MEXPORT_ALGEBRA int cancelsqrtgcd(term t, term arg, term *next, char *reason)
/* example �(x^2-1) /�(x-1)   = �((x-1)(x+1))/�(x-1)  */
/* similar to cancelgcd but works under �            */
/* If the numerator is or has a factor �u and the denom
is or has a factor �v then factor gcd(u,v) out of both u and v  */

{ return sqrtgcd_aux(SQRT,t,arg,next,reason);
}

/*_______________________________________________________________________*/
MEXPORT_ALGEBRA int cancelrootgcd(term t, term arg, term *next, char *reason)
/* example ��(x^2-1) /��(x-1)   = ��((x-1)(x+1))/��(x-1)  */
/* similar to cancelgcd but works under ��            */
/* If the numerator is or has a factor ��u and the denom
is or has a factor ��v then factor gcd(u,v) out of both u and v  */

{ return sqrtgcd_aux(ROOT,t,arg,next,reason);
}
/*_______________________________________________________________________*/
MEXPORT_ALGEBRA int cancelabsgcd(term t, term arg, term *next, char *reason)
/* example |(x^2-1)| /|(x-1)|   = |(x-1)(x+1)|/|x-1|  */
/* If the numerator is or has a factor |u| and the denom
is or has a factor |v| then factor gcd(u,v) out of both u and v  */

{ return sqrtgcd_aux(ABS,t,arg,next,reason);
}
/*_______________________________________________________________________*/
static int sqrtgcd_aux(unsigned short f, term t, term arg, term *next, char *reason)
/* f is SQRT, ROOT, or ABS.
Do as cancelsqrtgcd is documented to do for SQRT, but for functor f */

{ term u,v,num,denom,temp,p,q,index;
  unsigned short n,m;
  unsigned short path[MAXTAIL+4];
  unsigned short *oldpath;
  int i,j,k,err;
  if(FUNCTOR(t) != '/')
      return 1;
  num = ARG(0,t);
  denom = ARG(1,t);
  if(!contains_sqrt(denom) || !contains_sqrt(num))
      return 1;
  if(FUNCTOR(num) == f && FUNCTOR(denom) == f)
      { if(f == ROOT)
          { index = ARG(0,num);
            if(!equals(index,ARG(0,denom)))
                return 1;
            u = ARG(1,num);
            v = ARG(1,denom);
          }
        else
          { u = ARG(0,num);
            v = ARG(0,denom);
          }
        p = make_fraction(u,v);
        err = cancelgcd(p,arg,&temp,reason);
        if(err)
           { RELEASE(p);
             return 1;
           }
        /* cancelgcd may have called set_pathtail and SetShowStepOperation
           to make this look like a factorization in num or denom.
           If so, we need to fetch the path it stored and modify it to account for
           the SQRT, ABS, or ROOT. */
        oldpath = get_pathtail();
        if(oldpath[0] == '/')
           { path[0] = '/';
             path[1] = oldpath[1];
             path[2] =  f;
             path[3] = (unsigned short)(f == ROOT ? 2 : 1);
             path[4] = 0;
             pathcat(path,oldpath+2);
             set_pathtail(path);
           }
        switch(f)
          { case SQRT:
               *next = make_fraction(make_sqrt(ARG(0,temp)),make_sqrt(ARG(1,temp)));
               break;
            case ABS:
               *next = make_fraction(abs1(ARG(0,temp)),abs1(ARG(1,temp)));
               break;
            case ROOT:
               *next = make_fraction(make_root(index,ARG(0,temp)),make_root(index,ARG(1,temp)));
               break;
            default:
               assert(0);
          }
        HIGHLIGHT(*next);
        return 0;
     }
  if(FUNCTOR(num) == '*' && FUNCTOR(denom) == f)
     { v = f== ROOT ? ARG(1,denom) : ARG(0,denom);
       if(f == ROOT)
          index = ARG(0,denom);
       n = ARITY(num);
       for(i=0;i<n;i++)
          { if(FUNCTOR(ARG(i,num)) == f &&
               (f != ROOT || equals(ARG(0,ARG(i,num)),index))
              )
               { u = f == ROOT ? ARG(1,ARG(i,num)) : ARG(0,ARG(i,num));
                 p = make_fraction(u,v);
                 err = cancelgcd(p,arg,&temp,reason);
                 if(err)
                     { RELEASE(p);
                       continue;
                     }
                 q = make_term('*',n);
                 for(k=0;k<n;k++)  /* so as not to alter the args of num */
                    ARGREP(p,k, ARG(k,num));
                 switch(f)
                    { case SQRT:
                         ARGREP(q,i,make_sqrt(ARG(0,temp)));
                         break;
                      case ABS:
                         ARGREP(q,i,abs1(ARG(0,temp)));
                         break;
                      case ROOT:
                         ARGREP(q,i,make_root(index,ARG(0,temp)));
                         break;
                      default:
                         assert(0);
                    }
                 oldpath = get_pathtail();
                 if(oldpath[0] == '/' && oldpath[1] == 2)
                    { /* the factorization was in the denominator */
                      path[0] = '/';
                      path[1] = 2;
                      path[2] = f;
                      path[3] = (unsigned short)(f == ROOT ? 2 : 1);
                      path[4] = 0;
                      pathcat(path,oldpath+2);
                      set_pathtail(path);
                    }
                 HIGHLIGHT(ARG(i,q));
                 HIGHLIGHT(denom);
                 *next = make_fraction(q,denom);
                 return 0;
              }
          }
     }
  if (FUNCTOR(denom) == '*' && FUNCTOR(num) == f)
     { u = f==ROOT ? ARG(1,num) : ARG(0,num);
       n = ARITY(denom);
       for(i=0;i<n;i++)
          { if(FUNCTOR(ARG(i,denom)) == f &&
               (f != ROOT || equals(ARG(0,ARG(i,denom)),index))
              )
               { v = f==ROOT? ARG(1,ARG(i,denom)) : ARG(0,ARG(i,denom));
                 p = make_fraction(u,v);
                 err = cancelgcd(p,arg,&temp,reason);
                 if(err)
                     { RELEASE(p);
                       continue;
                     }
                 q = make_term('*',n);
                 for(k=0;k<n;k++)
                     ARGREP(q,k,ARG(k,denom));
                 switch(f)
                    {  case SQRT:
                          ARGREP(q,i,make_sqrt(ARG(1,temp)));
                          break;
                       case ABS:
                          ARGREP(q,i,abs1(ARG(1,temp)));
                          break;
                       case ROOT:
                          ARGREP(q,i,make_root(index,ARG(1,temp)));
                          break;
                       default: assert(0);
                    }
                 oldpath = get_pathtail();
                 if(oldpath[0] == '/' && oldpath[1] == 1)
                    { /* the factorization was in the numerator */
                      path[0] = '/';
                      path[1] = 1;
                      path[2] = f;
                      path[3] =(unsigned short)(f == ROOT ? 2 : 1);
                      path[4] = 0;
                      pathcat(path,oldpath+2);
                      set_pathtail(path);
                    }
                 HIGHLIGHT(ARG(i,q));
                 HIGHLIGHT(num);
                 *next = make_fraction(num,q);
                 return 0;
              }
          }
     }
  if (FUNCTOR(num) == '*' && FUNCTOR(denom) == '*')
     { n = ARITY(num);
       m = ARITY(denom);
       for(i=0;i<n;i++)
         { if(FUNCTOR(ARG(i,num)) == f)
              { u = f==ROOT ? ARG(1,ARG(i,num)) : ARG(0,ARG(i,num));
                if(f==ROOT)
                   index = ARG(0,ARG(i,num));
                for(j=0;j<m;j++)
                   { if(FUNCTOR(ARG(j,denom))==f &&
                        (f != ROOT || equals(ARG(0,ARG(j,denom)),index))
                       )
                        { v = f==ROOT? ARG(1,ARG(j,denom)) : ARG(0,ARG(j,denom));
                          p = make_fraction(u,v);
                          err = cancelgcd(p,arg,&temp,reason);
                          if(err)
                             continue;
                          p = make_term('*',n);
                          for(k=0;k<n;k++)
                             ARGREP(p,k,ARG(k,num));
                          q = make_term('*',m);
                          for(k=0;k<m;k++)
                             ARGREP(q,k,ARG(k,denom));
                          switch(f)
                             { case SQRT:
                                  ARGREP(p,i,make_sqrt(ARG(0,temp)));
                                  ARGREP(q,j,make_sqrt(ARG(1,temp)));
                                  break;
                               case ABS:
                                  ARGREP(p,i,abs1(ARG(0,temp)));
                                  ARGREP(q,j,abs1(ARG(1,temp)));
                                  break;
                               case ROOT:
                                  ARGREP(p,i,make_root(index,ARG(0,temp)));
                                  ARGREP(q,j,make_root(index,ARG(1,temp)));
                                  break;
                             }
                          oldpath = get_pathtail();
                          if(oldpath[0])
                             { oldpath = get_pathtail();
                               if(oldpath[0] == '/')
                                  { path[0] = '/';
                                    path[1] = oldpath[1];
                                    path[2] = '*';
                                    path[3] =(unsigned short) (path[1] == 1 ? i+1 : j+1);
                                    path[4] = f;
                                    path[5] =(unsigned short) (f == ROOT ? 2 : 1);
                                    path[6] = 0;
                                    pathcat(path,oldpath+2);
                                    set_pathtail(path);
                                  }
                             }
                          HIGHLIGHT(ARG(i,p));
                          HIGHLIGHT(ARG(j,q));
                          *next = make_fraction(p,q);
                          return 0;
                        }
                   }
              }
         }
     }
  return 1;
}
/*_____________________________________________________________*/
static int cancelsqrt_aux(term u, term v, term *ans)
/* v is a SQRT;  cancel v from u using x/�x = �x if possible.
Return 0 for success, 1 for failure.  In case of failure,
*ans can be garbage. */
{ term x,newpower,temp,s,cancelled,q;
  int i,j,err;
  aflag saveit = get_arithflag();
  aflag newflag = saveit;
  unsigned short n;
  assert(FUNCTOR(v) == SQRT);
  x = ARG(0,v);
  if(equals(u,x))
     { *ans = v;
       HIGHLIGHT(*ans);
       return 0;
     }
  if(FUNCTOR(u) == '^')
     { if (!equals(x,ARG(0,u)))
          return 1;
       if (NEGATIVE(ARG(1,u)))
          return 1;
       if(get_polyvalfractexpflag())   /* fractional exponents allowed */
          { temp = sum(ARG(1,u),tnegate(make_fraction(one,two)));
            newflag.comdenom = 1;
            set_arithflag(newflag);
            err = value(temp,&newpower);
            set_arithflag(saveit);
            if(err == 1)
               newpower = temp;
            *ans = make_power(x,newpower);
            HIGHLIGHT(*ans);
            return 0;
          }
       else   /* fractional exponents not allowed */
          { if(contains(ARG(1,u),'/'))
               return 1;  /* don't do:  x^(2/3)/sqrt x = x^(-1/3) sqrt x */
            temp = sum(ARG(1,u),minusone);
            err = value(temp,&newpower);
            if(err == 1)
               newpower = temp;
            *ans = product(make_power(x,newpower),v);
            HIGHLIGHT(*ans);
            if(FUNCTOR(*ans) =='*')
                 /* which it is, unless the original exponent was 1 */
               { HIGHLIGHT(ARG(0,*ans));
                 HIGHLIGHT(ARG(1,*ans));
               }
            return 0;
          }
     }
  if(FUNCTOR(u) != '*')
     return 1;
  n = ARITY(u);
  for(i=0;i<n;i++)
     { s = ARG(i,u);
       if(equals(s,x))
          break;
       if(FUNCTOR(s) == '^' && !NEGATIVE(ARG(1,s)) && equals(ARG(0,s),x))
          break;
     }
  if(i==n)
     { if(FUNCTOR(x) != '*')
           return 1;   /* no factor of x or power of x found */
       /* But, there's still the possibility that all the factors of
          x may occur somewhere in u, e.g. 2 ab/ sqrt(ab),
          in which case x = ab */
       err = cancel(u,x,&cancelled,&q);
       if(err)
          return 1;
       s = sqrt1(x);
       HIGHLIGHT(s);
       *ans = product(q,s);
       if(FUNCTOR(*ans) == '*')
          sortargs(*ans);
       return 0;
     }
  err = cancelsqrt_aux(s,v,&temp);
  if(err)
     return 1;  /* example,  s = x^(4/5) with polyvalfractexpflag off */
  if(FUNCTOR(temp) != '*')
     { *ans = make_term('*',n);
       for(j=0;j<n;j++)
          ARGREP(*ans,j, j==i ? temp : ARG(j,u));
     }
  else
     { *ans = make_term('*',(unsigned short)(n-1+ARITY(temp)));
       for(j=0;j<i;j++)
          ARGREP(*ans,j,ARG(j,u));
       for(j=i;j<i+ARITY(temp);j++)
          ARGREP(*ans,j,ARG(j-i,temp));
       for(j=i+ARITY(temp); j < ARITY(*ans); j++)
          ARGREP(*ans,j,ARG(j-ARITY(temp)+1,u));
     }
  return 0;
}
/*_____________________________________________________________*/
MEXPORT_ALGEBRA int cancelsqrt(term t, term arg, term *next, char *reason)
/* x/�x = �x */
/* Must also work on any fraction containing  powers of x as factors
of the numerator and �x as a factor in the denominator  */
{ int i,j,err;
  unsigned short n;
  term u,v,s,newnum,newdenom;
  if(FUNCTOR(t) != '/')
     return 1;
  u = ARG(0,t);
  v = ARG(1,t);
  if(FUNCTOR(v) == SQRT)
     { err = cancelsqrt_aux(u, v, next);
       if(err)
          return 1;
       goto out;
     }
  if(FUNCTOR(v) != '*')
     return 1;
  /* look for � in the denominator */
  n = ARITY(v);
  for(i=0;i<n;i++)
     { s = ARG(i,v);
       if(FUNCTOR(s) == SQRT)
          { err = cancelsqrt_aux(u, s, &newnum);
            if(err)
               continue;
            break;
          }
     }
  if(i==n)   /* no sqrt can be cancelled */
     return 1;
  if(n==2)
     newdenom = ARG(i ? 0 : 1, v);
  else
     { newdenom = make_term('*',(unsigned short)(n-1));
       for(j=0;j<n-1;j++)
          ARGREP(newdenom,j, ARG(j<i ? j : j+1, v));
     }
  *next = make_fraction(newnum,newdenom);
  out:
     strcpy(reason,"$x/�x = �x$");
     return 0;
}
/*_____________________________________________________________*/
MEXPORT_ALGEBRA int cancelsqrt2(term t, term arg, term *next, char *reason)
/* �x/x = 1/�x */
/* Must also work on any fraction containing  powers of x as factors
of the denominator and �x as a factor in the numerator  */

{ int err;
  term temp;
  if(FUNCTOR(t) != '/')
     return 1;
  err = cancelsqrt(reciprocal(t),arg,&temp,reason);
  if(err)
     return 1;
  *next = reciprocal(temp);
  strcpy(reason,"$�x/x = 1/�x$");
  HIGHLIGHT(*next);
  return 0;
}
/*_____________________________________________________________*/
static int cancelroot_aux(term u, term v, term *ans)
/* v is a ROOT;  cancel v from u using x/��x = (�x)^(n-1) if possible.
Return 0 for success, 1 for failure.  In case of failure,
*ans can be garbage. */
{ term x,newpower,temp,s,index,p;
  aflag arithflag = get_arithflag();
  int i,j,err;
  aflag saveit = arithflag;
  unsigned short n;
  assert(FUNCTOR(v) == ROOT);
  x = ARG(1,v);
  index = ARG(0,v);
  if(ISINTEGER(index))  /* bignum root indices aren't allowed anyway */
     p = make_int(INTDATA(index)-1);
  else
     p = sum(index,minusone);
  if(equals(u,x))
     { *ans = make_power(v,p);
       HIGHLIGHT(*ans);
       return 0;
     }
  if(FUNCTOR(u) == '^')
     { if (!equals(x,ARG(0,u)))
          return 1;
       if (NEGATIVE(ARG(1,u)))
          return 1;
       if(get_polyvalfractexpflag())   /* fractional exponents allowed */
          { temp = sum(ARG(1,u),tnegate(make_fraction(one,index)));
            arithflag.comdenom = 1;
            set_arithflag(arithflag);
            err = value(temp,&newpower);
            set_arithflag(saveit);
            if(err == 1)
               newpower = temp;
            *ans = make_power(x,newpower);
            HIGHLIGHT(*ans);
            return 0;
          }
       else   /* fractional exponents not allowed */
          { temp = sum(ARG(1,u),minusone);
            err = value(temp,&newpower);
            if(err == 1)
               newpower = temp;
            *ans = product(make_power(x,newpower),make_power(v,p));
            HIGHLIGHT(*ans);
            if(FUNCTOR(*ans) =='*')
                 /* which it is, unless the original exponent was 1 */
               { HIGHLIGHT(ARG(0,*ans));
                 HIGHLIGHT(ARG(1,*ans));
               }
            return 0;
          }
     }
  if(FUNCTOR(u) != '*')
     return 1;
  n = ARITY(u);
  for(i=0;i<n;i++)
     { s = ARG(i,u);
       if(equals(s,x))
          break;
       if(FUNCTOR(s) == '^' && !NEGATIVE(ARG(1,s)) && equals(ARG(0,s),x))
          break;
     }
  if(i==n)
     return 1;   /* no factor of x or power of x found */
  err = cancelroot_aux(s,v,&temp);
  assert(!err);
  if(FUNCTOR(temp) != '*')
     { *ans = make_term('*',n);
       for(j=0;j<n;j++)
          ARGREP(*ans,j, j==i ? temp : ARG(j,u));
     }
  else
     { *ans = make_term('*',(unsigned short)(n-1+ARITY(temp)));
       for(j=0;j<i;j++)
          ARGREP(*ans,j,ARG(j,u));
       for(j=i;j<i+ARITY(temp);j++)
          ARGREP(*ans,j,ARG(j-i,temp));
       for(j=i+ARITY(temp); j < ARITY(*ans); j++)
          ARGREP(*ans,j,ARG(j-ARITY(temp)+1,u));
     }
  return 0;
}
/*_____________________________________________________________*/
MEXPORT_ALGEBRA int cancelroot(term t, term arg, term *next, char *reason)
/* x/��x = (��x)^(n-1) */
/* Must also work on any fraction containing  powers of x as factors
of the numerator and ��x as a factor in the denominator  */
{ int i,j,err;
  unsigned short n;
  term u,v,s,newnum,newdenom;
  if(FUNCTOR(t) != '/')
     return 1;
  u = ARG(0,t);
  v = ARG(1,t);
  if(FUNCTOR(v) == ROOT)
     { err = cancelroot_aux(u, v, next);
       if(err)
          return 1;
       goto out;
     }
  if(FUNCTOR(v) != '*')
     return 1;
  /* look for �� in the denominator */
  n = ARITY(v);
  for(i=0;i<n;i++)
     { s = ARG(i,v);
       if(FUNCTOR(s) == ROOT)
          { err = cancelroot_aux(u, s, &newnum);
            if(err)
               continue;
            break;
          }
     }
  if(i==n)   /* no root can be cancelled */
     return 1;
  if(n==2)
     newdenom = ARG(i ? 0 : 1, v);
  else
     { newdenom = make_term('*',(unsigned short)(n-1));
       for(j=0;j<n-1;j++)
          ARGREP(newdenom,j, ARG(j<i ? j : j+1, v));
     }
  *next = make_fraction(newnum,newdenom);
  out:
     strcpy(reason,"$x/��x = (��x)^(n-1)$");
     return 0;
}

/*_____________________________________________________________*/
MEXPORT_ALGEBRA int cancelroot2(term t, term arg, term *next, char *reason)
/* ��x/x = 1/(��x)^(n-1) */
/* Must also work on any fraction containing  powers of x as factors
of the numerator and ��x as a factor in the denominator  */

{ int err;
  term temp;
  if(FUNCTOR(t) != '/')
     return 1;
  err = cancelroot(reciprocal(t),arg,&temp,reason);
  if(err)
     return 1;
  *next = reciprocal(temp);
  strcpy(reason,"$��x/x = 1/(��x)^(n-1)$");
  HIGHLIGHT(*next);
  return 0;
}
/*_____________________________________________________________*/
MEXPORT_ALGEBRA int cancel_abs(term t, term *next)
/* Does the work of cancelabs3, namely
|ab|/|ac| = |b|/|c| and
|ab|/|a| = |b|
*/
/* Must also work on any fraction containing  powers of x as factors
of the numerator and �x as a factor in the denominator  */

{ int i,j,err;
  unsigned short n,fnum,fden;
  term num, denom,u,v,w,temp,cancelled,p;
  if(FUNCTOR(t) != '/')
      return 1;
  num = ARG(0,t);
  denom = ARG(1,t);
  fnum = FUNCTOR(num);
  fden = FUNCTOR(denom);
  if(fnum == ABS && fden == ABS)
      { u = ARG(0,num);
        v = ARG(0,denom);
        if(NEGATIVE(u) && FUNCTOR(u) == '*')
           return 1;
        if(NEGATIVE(v) && FUNCTOR(v) == '*')
           return 1;
        err = cancel(u,v,&cancelled,&temp);
        if(err)
           return 1;
        if(FRACTION(temp))
           *next = make_fraction(ONE(ARG(0,temp)) ? one : abs1(ARG(0,temp)),abs1(ARG(1,temp)));
        else
           *next = abs1(temp);
        return 0;
      }
  if(FUNCTOR(num) == '*' && (FUNCTOR(denom) == ABS || FUNCTOR(denom) == '*'))
     { n = ARITY(num);
       for(i=0;i<n;i++)
          { w = ARG(i,num);
            if(FUNCTOR(w) != ABS)
               continue;
            err = cancel_abs(make_fraction(w,denom),&temp);
            if(!err)
                break;
          }
       if(i==n)
          return 1;
       if(!FRACTION(temp))
          { p = make_term('*',n);
            for(j=0;j<n;j++)  /* so as not to alter the args of num */
               ARGREP(p,j, i==j ? temp : ARG(j,num));
            *next = topflatten(p);
          }
       else if(ONE(ARG(0,temp)) && n == 2)
          *next = make_fraction(ARG(i ? 0 : 1,num), ARG(1,temp));
       else if(ONE(ARG(0,temp)))
          { p = make_term('*',(unsigned short)(n-1));
            for(j=0;j<n-1;j++)
               ARGREP(p,j,j<i ? ARG(j,num) : ARG(j+1,num));
            *next = make_fraction(p,ARG(1,temp));
          }
       else
          { p = make_term('*',n);
            for(j=0;j<n;j++)
               ARGREP(p,j,i==j ? ARG(0,temp) : ARG(j,num));
            *next = make_fraction(topflatten(p),ARG(1,temp));
          }
       return 0;
     }
  if(FUNCTOR(denom) == '*' && FUNCTOR(num) == ABS)
     { err= cancel_abs(make_fraction(denom,num),&temp);
       if(err)
          return 1;
       *next = reciprocal(temp);
       return 0;
     }
  return 1;
}

Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists