(*:Copyright: Copyright 1988-1999 Wolfram Research, Inc. *)

(*:Mathematica Version: 3.0 *)

(*:Package Version: 1.0 *)

(*:Name: NumberTheory`PrimitiveElement` *)

(*:Title: Primitive elements of algebraic extensions of rationals.*) 

(*:Author: Adam Strzebonski *)

(*:Keywords: primitive elements, algebraic field extensions *)

(*:Requirements: None. *)

(*:Sources:
	Computing in Algebraic Extensions, R.Loos, Computing, Suppl.4,
	173-187 (1982).
*)

(*:Summary:
This package defines function for finding primitive elements of multiple
algebraic extensions of rationals.
*)

BeginPackage["NumberTheory`PrimitiveElement`"]

Unprotect[PrimitiveElement]

PrimitiveElement::usage = "PrimitiveElement[z, {a1,...,an}] returns a pair {r, {f1,...,fn}}, where r is a primitive element for the extension of rationals by algebraic numbers a1,...,an, and f1,...,fn are polynomials in z such that ai==fi/.z->r for 1<=i<=n."

Begin["`Private`"]

RootReduce[0];

primel[z_,a_,b_] :=
         Module[{R,t=0,d=False,x,y,f,g,c,h},
	        f=RootsDump`MinimalPolynomial[a,x];
		g=RootsDump`MinimalPolynomial[b,y];
	        While[!d,
		      t++;
	              R=Resultant[f/.x->x-t y,g,y]; 
		      d=NumberQ[PolynomialGCD[R,D[R,x]]]]; 
		c=RootReduce[a+t b]; 
		h=RootsDump`MinimalPolynomial[c,z]; 
		d=PolynomialGCD[f/.x->z-t y,g,Modulus->h]; 
		g=Expand[-Coefficient[d,y,0]/Coefficient[d,y,Exponent[d,y]]];
		f=z-t g;
		{c,f,g}]

validinput[z_,as_] := (Head[z]===Symbol) && (Length[as]>0) &&
                     And@@(RootsDump`algnumQ/@as)
		
PrimitiveElement[z_,as_]/;validinput[z,as]:=
	 Module[{a=as[[1]],b,p,fs={z},i},
	        Do[b=as[[i]];
		   b=primel[z,a,b];
		   a=b[[1]]; p=RootsDump`MinimalPolynomial[a,z];
		   fs=fs/.z->b[[2]];
		   fs=PolynomialRemainder[#,p,z]&/@fs;
		   fs=Append[fs,b[[3]]],
		   {i,2,Length[as]}];
		{a,fs}]
		
End[] (* `Private` *)

Protect[PrimitiveElement]
		
EndPackage[]		
