// $Id: primitiv.lib,v 1.3 1998-04-03 22:47:11 krueger Exp $
// This library requires Singular 1.0

version="$Id: primitiv.lib,v 1.3 1998-04-03 22:47:11 krueger Exp $";
info="
LIBRARY:    primitiv.lib    PROCEDURES FOR FINDING A PRIMITIVE ELEMENT

 primitivE(ideal i); finds minimal polynomial for a primitive element

 splitring(poly f,string R[,list L]);  define ring extension with name R
                                       and switch to it
 randomLast(int b);       random transformation of the last variable
";

LIB "random.lib";
///////////////////////////////////////////////////////////////////////////////

proc randomLast(int b)
USAGE:   randomLast
RETURN:  ideal = maxideal(1) but the last variable exchanged by
         a sum of it with a linear random combination of the other
         variables
NOTE:   
EXAMPLE: example randomLast; shows an example
{
  ideal i=maxideal(1);
  int k=size(i);
  i[k]=0;
  i=randomid(i,size(i),b);
  ideal ires=maxideal(1);
  ires[k]=i[1]+var(k);
  return(ires);
}
example
{ "EXAMPLE:"; echo = 2;
   ring  r = 0,(x,y,z),lp;
   ideal i = randomLast(10);
   i;
}
///////////////////////////////////////////////////////////////////////////////

proc primitivE(ideal i)
USAGE:  primitivE(i); i ideal of the following form:
 Let k be the ground field of your basering, a_1,...,a_n algebraic over k,
 m_1(x1), m_2(x_1,x_2),...,m_n(x_1,...,x_n) polynomials in k such that
 m_j(a_1,...,a_(j-1),x_j) is minimal polynomial for a_j over k(a_1,...,a_(j-1))
                                                        for all j=1,...,n.
 Then i has to be generated by m_1,...,m_n.

RETURN: ideal j in k[x_n] such that
 j[1] is minimal polynomial for a primitive element b of k(a_1,...,a_n)=k(b)
         over k
 j[2],...,j[n+1] polynomials in k[x_n] : j[i+1](b)=a_i for i=1,...,n
NOTE: the number of variables in the basering has to be exactly the number n of
      given algebraic elements (and minimal polynomials)
EXAMPLE:    example primitivE;  shows an example
{
 def altring=basering;
 execute("ring deglexring=("+charstr(altring)+"),("+varstr(altring)+"),dp;");
 ideal j;
 execute("ring lexring=("+charstr(altring)+"),("+varstr(altring)+"),lp;");
 ideal i=fetch(altring,i);

 int k,schlecht;
 int nva = nvars(basering);
 ideal jmap,j;
 map phi;
 option(redSB);
 int Fehlversuche;
 //-------- Mache so lange Random-Koord.wechsel, bis letztes Poly -------------
 //--------------- das Minpoly eines primitiven Elements ist : ----------------
 for (Fehlversuche=0; 1; Fehlversuche++) {
   schlecht=0;
   if (Fehlversuche==0) { jmap=maxideal(1);}
   else {
     if (Fehlversuche<3) { jmap=randomLast(10);}
     else                { jmap=randomLast(100);}
   }
   phi=lexring,jmap;
   j=phi(i);
   setring deglexring;
 //--------------- Berechne reduzierte Standardbasis mit fglm: ----------------
   j=std(fetch(lexring,j));
   setring lexring;
   j=fglm(deglexring,j);
 //-- teste, ob SB n Elemente enthaelt (falls ja, ob lead(Fi)=xi i=1... n-1): -
   if (size(j)==nva) {
     for (k=1; k<nva; k++) {
       j[k+1]=j[k+1]/leadcoef(j[k+1]);        // normiere die Erzeuger
       if (lead(j[k+1]) != var(nva-k)) { schlecht=1;}
     }
     if (schlecht==0) {
 //--- Random-Koord.wechsel war gut: Berechne das zurueckzugebende Ideal: -----
       ideal erg;
       for (k=1; k<nva; k++) { erg[k]=var(k)-j[nva-k+1]; }
                               // =g_k(x_n) mit a_k=g_k(a_n)
       erg[nva]=var(nva);
       map chi=lexring,erg;
       ideal extra=maxideal(1);extra=phi(extra);
                               // sonst: "argument of a map must have a name"
       erg=j[1]+chi(extra);    // j[1] = Minimalpolynom
       setring altring;
       return(fetch(lexring,erg));
     }
   }
   "The random coordinate change was bad!";
 }
}
example
{ "EXAMPLE:"; echo = 2;
 ring exring=0,(x,y),dp;
 ideal i=x2+1,y2-x;                  // compute Q(i,i^(1/2))=:L
 ideal j=primitivE(i);               // -> we have L=Q(a):
 "minimal polynomial of a:",j[1];    // => a=(-1)^(1/4)
 "polynomial for i:       ",j[2];    // => i=a^2
 "polynomial for i^(1/2): ",j[3];    // => i^(1/2)=a
 // ==> the 2nd element was already primitive!
 j=primitivE(ideal(x2-2,y2-3));      // compute Q(sqrt(2),sqrt(3))
 "minimal polynomial:",j[1];
 "polynomial p s.t. p(a)=sqrt(2):",j[2];
 "polynomial r s.t. r(a)=sqrt(3):",j[3];
 // ==> no element was primitive -- the calculation of a is based on a random
 //     choice.
}
///////////////////////////////////////////////////////////////////////////////

proc splitring
USAGE:  splitring(f,R[,L]);  f poly, univariate, irreducible(!), R string,
                     L list of polys and/or ideals (optional)
ACTION: defines a ring with name R, in which f is reducible, and changes to it
        If the old ring has no parameter, the name 'a' is chosen for the
        parameter of R (if a is no variable; if it is, the proc takes 'b'; if
        this is also impossible, then 'c'), otherwise the name of the parameter
        is kept and only the minimal polynomial is changed.
        The names of variables and orderings are not affected.

        It is also allowed to call splitring with R=="". Then the old basering
        will be REPLACED by the new ring (with the same name as the old ring).

RETURNs: list L mapped into the new ring R, if L is given; else nothing
ASSUME : the active ring must be bivariate and allow an algebraic extension
         (e.g. it cannot be a transcendent ring extension of Q or Z/p)
EXAMPLE: example splitring;  shows an example
{
 //----------------- split ist bereits eine proc in 'inout.lib' ! -------------
 poly f=#[1]; string @R=#[2];
 if (size(#)>2) {
    list L=#[3];
    int L_groesse=size(L);
 }
 else { int L_groesse=-1; }
 //-------------- ermittle das Minimalpolynom des aktuellen Rings: ------------
 string minp=string(minpoly);

 if (@R=="") {
  string altrname=nameof(basering);
  @R="splt_temp";
 }

 def altring=basering;
 string charakt=string(char(altring));
 string varnames=varstr(altring);
 string algname;
 //--------------- Fall 1: Bisheriger Ring hatte kein Minimalpolynom ----------
 if (minp=="0") {
  if (find(varnames,"a")==0)        { algname="a";}
  else { if (find(varnames,"b")==0) { algname="b";}
         else                       { algname="c";}
 //----------- nur ZWEI Variablen erlaubt ==> c ist kein Variablenname --------
  }
 //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: --
  execute("ring splt1="+charakt+","+algname+",dp;");
  map nach_splt1=altring,var(1),var(1);
  execute("poly mipol="+string(nach_splt1(f))+";");
  string Rminp=string(mipol);
 //--------------------- definiere den neuen Ring: ----------------------------
  execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("
           +ordstr(altring)+");");
  execute("minpoly="+Rminp+";");
  execute("export "+@R+";");
  def neuring=basering;
 //---------------------- Berechne die zurueckzugebende Liste: ----------------
  list erg;
  if (L_groesse>0) {
 // L ist ja nicht in 'neuring' def., daher merke man sich die Groesse als int
   map take=altring,maxideal(1);
   erg=take(L);
  }            // take(empty list) gibt nicht empty list, sondern Fehlermeldung
 }
 else {
 //------------- Fall 2: Bisheriger Ring hatte ein Minimalpolynom: ------------
  algname=parstr(altring);           // Name des algebraischen Elements
  if (size(algname)>1) {"only one Parameter is allowed!!"; return();}
 //---------------- Minimalpolynom in ein Polynom umwandeln: ------------------
  execute("ring splt2="+charakt+","+algname+",dp;");
  execute("poly mipol="+minp+";");
 // f ist Polynom in algname und einer weiteren Variablen --> mache f bivariat:
  execute("ring splt3="+charakt+",("+algname+","+varnames+"),dp;");
  poly f=imap(altring,f);
 //-------------- Vorbereitung des Aufrufes von primitivE: --------------------
  execute("ring splt1="+charakt+",(x,y),dp;");
  map nach_splt1_3=splt3,x,y,y;
  map nach_splt1_2=splt2,x;
  ideal maxid=nach_splt1_2(mipol),nach_splt1_3(f);
  ideal primit=primitivE(maxid);
  "new minimal polynomial:",primit[1];
 //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: --
  setring splt2;
  map nach_splt2=splt1,0,var(1);     // x->0, y->a
  minp=string(nach_splt2(primit)[1]);
 //--------------------- definiere den neuen Ring: ----------------------------
  execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("+ordstr(altring)+");");
  execute("minpoly="+minp+";");
  execute("export "+@R+";");
  def neuring=basering;

 //--------------- Uebersicht: wenn altring=(p,a),(x,y),dp; dann: -------------
 //------------ splt1=p,(x,y),dp;  splt2=p,a,dp;  splt3=p,(a,x,y),dp; ---------

  list erg;
  if (L_groesse>0) {
 //---------------------- Berechne die zurueckzugebende Liste: ----------------
    setring splt3;
    list zwi=imap(altring,L);
    map nach_splt3_1=splt1,0,var(1);  // x->0, y->a
 //----- rechne das primitive Element von altring in das von neuring um: ------
    map convert=splt3,nach_splt3_1(primit)[2],var(2),var(3); 
    zwi=convert(zwi);
    setring neuring;
    erg=imap(splt3,zwi);
  }
 }
 if (defined(altrname)) {
   execute("kill "+altrname+";");
   execute("def "+altrname+" = splt_temp;");
   @R=altrname;
   execute("export "+altrname+";");
   kill splt_temp;
 }

 execute("keepring "+@R+";");
 if (L_groesse >= 0) {return(erg);}
}
example
{ "EXAMPLE:"; echo = 2;
 ring r=0,(x,y),dp;
 splitring(x2-2,"r1");   // change to Q(sqrt(2))
 splitring(x2-a,"r2",a); // change to Q(sqrt(2),sqrt(sqrt(2)))=Q(a)
                         // and return the transformed old parameter
 // the result is (a2) == (sqrt(sqrt(2)))^2
 nameof(basering);
 r2;
 kill r1; kill r2;
}