source: git/Singular/LIB/primitiv.lib @ 18dd47

// $Id: primitiv.lib,v 1.1 1997-06-30 12:31:44 Singular Exp $
// This library requires Singular 1.0

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 ringextension 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;
 //def P=basering;
 int nva = nvars(basering);
 ideal jmap,j;
 map phi;
 option(redSB);
 int Fehlversuche;

 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;

   // j=std(fetch(lexring,phi(i)));j; will er nicht
   j=std(fetch(lexring,j));
   setring lexring;
   j=fglm(deglexring,j);
 //testen, ob SB n Elemente enthaelt
 // falls ja 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;} // Random-Koord.transf. war schlecht gewaehlt
     }
     if (schlecht==0) {
       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(poly f, string @R, list L)
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
NOTE   : it is assumed that the active ring is bivariate
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;

 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
  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);
  execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("+ordstr(altring)+");");
  execute("minpoly="+Rminp+";");
  //execute("def neuring="+@R+";");
  execute("export "+@R+";");
  def neuring=basering;

  list erg;
  if (L_groesse>0) {  // L ist ja nicht in 'neuring' definiert, daher merke man
   map take=altring,maxideal(1);      // sich die Groesse als int
   erg=take(L);
  }            // take(empty list) gibt nicht empty list, sondern Fehlermeldung
 }
 else {
  algname=parstr(altring); // Name des algebraischen Elements
  //-string fstr=string(f);
  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;");
  //-execute("poly f="+fstr+";");
  poly f=imap(altring,f);  // ersetzt //- : fstr & execute
  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];
  setring splt2;
  map nach_splt2=splt1,0,var(1);     // x->0, y->a
  minp=string(nach_splt2(primit)[1]);
  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;

  if (L_groesse>0) {
    setring splt3;
    list zwi=imap(altring,L);
    map nach_splt3_1=splt1,0,var(1);  // x->0, y->a
    map convert=splt3,nach_splt3_1(primit)[2],var(2),var(3); 
    // rechnet das primitive Element von altring in das von neuring um
    zwi=convert(zwi);
    setring neuring;
    list 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;
}