Sindbad~EG File Manager

/* Factorization of POLYnomials */
/* Arithmetic on coefficients is done using 'value' */
/* M. Beeson
   Original date 3.7.92
   1.30.98 last modified
*/

#define ALGEBRA_DLL
#include <assert.h>
#include <string.h>
#include "globals.h"
#include "polynoms.h"
#include "order.h"
#include "mathmode.h"   /* get_mathmode */
#include "errbuf.h"

static term squarefree_aux(term, term *, term *);
/*____________________________________________________________________*/
static term squarefree_aux(POLYnomial t, term *gcd, term *cc)
/* t is a POLYnomial; returns the product of all squarefree factors of t.
Also returns indirectly the gcd of t and its derivative t', as a POLYnomial,
and a constant factor such that   ans * (*gcd) = (*cc) * t.
See page 212 of Computer Algebra by Davenport et. al. */

/* Assumes t has degree at least 1 */

{ term q,r,ans,b,c,d,e,temp;
  int err;
  assert(FUNCTOR(t)==POLY);
  if(ARITY(t) <= 2)   /* linear polynomial or constant */
     { *gcd = make_term(POLY,1);
       ARGREP(*gcd,0,one);
       *cc = one;
        return t;
     }
  *gcd = polynomial_gcd(t, polyderiv(t));
  if(ARITY(*gcd)==1)  /* constant POLYnomial */
     { *cc = one;
       return t;
     }
  pseudodiv(t,*gcd,&q,&r,&c);
  pseudodiv(q,polynomial_gcd(q,*gcd),&temp,&r,&d);
    /* temp can be non-primitive, e.g. if t = 4x^4 + 4x^2 + 1 */
  pp(temp,&b,&ans);
  e = make_fraction(product(d,c),b);
  err = value(e,cc);
  if(err == 1)
     *cc = e;
  return ans;
}
/*____________________________________________________________________*/
MEXPORT_ALGEBRA int squarefreefactors(term t, term arg, term *next, char *reason)
/* perform square-free factorization on t */
/* regarding t as a polynomial in varlist[eigenvariable] */

{ term x,p,u,c;
  term *atomlist;
  int natoms;
  int err,i;
  unsigned short n,k;
  unsigned long nbytes;
  if(FUNCTOR(t) != '+')
     return 1;
  x = get_eigenvariable();
  natoms = atomsin(t,&atomlist);
  free2(atomlist);
  if(natoms > 1)
     { errbuf(0, english(478));
        /* That only works on polynomials in one variable. */
       return 1;
     }
  nbytes = mycoreleft();
  if(nbytes < 24576)
      return 1;  /* don't risk running out of memory */
  err = makepoly(t,x,&p);
  if(err || ARITY(p) <= 2)
     return 1;   /* no use trying this on linear or constant polynomials */
  if(!intpolynomial(p))
     { errbuf(0, english(479));
          /* Coefficients must be integers. */
       return 1;
     }
  if(ARITY(p) > 25)
     return 1;  /* if 25 changes, change selectops so operation is shown.
                   Selectops won't show the operation on polynomials of degree > 25,
                   because polygcd runs out of space in squarefree_aux */
  u = squarefree(p,&c);
  assert(FUNCTOR(u) == '*');
  n = ARITY(u);
  *next = make_term('*',n);
  if(n==1)  /* no multiple roots */
     return 1;
  k=0;
  for(i=0;i<n;i++)
     { if(ARITY(ARG(i,u))==1 && ONE(ARG(0,ARG(i,u))))  /* unit POLYnomial */
           continue;
       if(i==0)
          ARGREP(*next,k,poly_term(ARG(i,u),x));
       else
          ARGREP(*next,k, make_power(poly_term(ARG(i,u),x),make_int(i+1)));
       k++;
     }
  RELEASE(u);  /* made by squarefree */
  SETFUNCTOR(*next,'*',k);
  assert(k > 0);
  if(k==1)
     *next = ARG(0,*next);
  else
     sortargs(*next);
  if(!ONE(c))
     *next = product(reciprocal(c),*next);
  HIGHLIGHT(*next);
  strcpy(reason, english(502));  /* square-free factors */
  return 0;
}
/*____________________________________________________________________*/
MEXPORT_ALGEBRA term squarefree(POLYnomial p, term *c)
/* p is a POLYnomial; return a product of POLYnomials giving the
square-free factorization of p, in the sense that ARG(k,p) is
the product of factors of multiplicity (k+1) in p,
and a constant term *c,
such that   *c�p  is equal to the return value.
This function always returns a product, even if its arity is 1;
arithmetic is performed on *c before returning.
Note that the powers (k+1) are NOT present in the answer;
the calling function must carefully use the return value, which
is a product of POLYnomials, not an ordinary term.
*/

{  POLYnomial a = p;
   term cc,gcd,ans,temp;
   unsigned short k = 0;
   int err;
   ans = make_term('*',ARITY(p));
   cc = make_term('*', ARITY(p));
   while(ARITY(a) > 1)
      { temp = squarefree_aux(a,&gcd,ARGPTR(cc)+k);
        /* temp is the product of all non-multiple roots of a */
        /* so this loop makes ARG(k,ans) the product of the roots of
           p of multiplicity k+1 */
        ARGREP(ans,k,temp);
        ++k;
        a = gcd;
      }
   SETFUNCTOR(ans,'*',k);
   SETFUNCTOR(cc,'*',k);
   if(k==1)
      *c = cc;
   else
      { err = value(cc,c);
        if(err == 1)
           *c = cc;
      }
   return ans;
}