Changeset f75297 in git for Singular/LIB

Timestamp:

Mar 4, 2011, 1:01:27 AM (13 years ago)

Author:

Viktor Levandovskyy <levandov@…>

Branches:

(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')

Children:

8eea069dd83d32f7e8b90cd5e5ec75124c7d7903

Parents:

a8f29f505ce6c0d6ff17e0e4d9637d320299deee

Message:

*levandov: checkin from Aachen, bugfixes and improvements

git-svn-id: file:///usr/local/Singular/svn/trunk@13924 2c84dea3-7e68-4137-9b89-c4e89433aadc

Location:

Singular/LIB

Files:

• bfun.lib (modified) (11 diffs)
• fpadim.lib (modified) (9 diffs)
• ncfactor.lib (modified) (2 diffs)

Singular/LIB/bfun.lib

@@ -41 +41 @@
 PROCEDURES:
 bfct(f[,s,t,v]);            compute the BS polynomial of f with linear reductions
-bfctSyz(f[,r,s,t,u,v]);  compute the BS polynomial of f with syzygy-solver
-bfctAnn(f[,s]);           compute the BS polynomial of f via Ann f^s + f
-bfctOneGB(f[,s,t]);     compute the BS polynomial of f by just one GB computation
-bfctIdeal(I,w[,s,t]);     compute the b-function of ideal w.r.t. weight
-pIntersect(f,I[,s]);      intersection of ideal with subalgebra K[f] for a polynomial f
+bfctSyz(f[,r,s,t,u,v]);     compute the BS polynomial of f with syzygy-solver
+bfctAnn(f[,s]);             compute the BS polynomial of f via Ann f^s + f
+bfctOneGB(f[,s,t]);         compute the BS polynomial of f by just one GB computation
+bfctIdeal(I,w[,s,t]);       compute the b-function of ideal w.r.t. weight
+pIntersect(f,I[,s]);        intersection of ideal with subalgebra K[f] for a polynomial f
 pIntersectSyz(f,I[,p,s,t]); intersection of ideal with subalgebra K[f] with syz-solver
 linReduce(f,I[,s]);         reduce a polynomial by linear reductions w.r.t. ideal
-linReduceIdeal(I,[s,t]);  interreduce generators of ideal by linear reductions
+linReduceIdeal(I,[s,t]);    interreduce generators of ideal by linear reductions
 linSyzSolve(I[,s]);         compute a linear dependency of elements of ideal I
+
+allPositive(v);             checks whether all entries of an intvec are positive
+scalarProd(v,w);            computes the standard scalar product of two intvecs
+vec2poly(v[,i]);            constructs an univariate polynomial with given coefficients
+
 
 SEE ALSO: dmod_lib, dmodapp_lib, dmodvar_lib, gmssing_lib
@@ -58 +63 @@
 ";
 
-//AUXILIARY PROCEDURES:
-//
-//allPositive(v);  checks whether all entries of an intvec are positive
-//scalarProd(v,w); computes the standard scalar product of two intvecs
-//vec2poly(v[,i]); constructs an univariate polynomial with given coefficients
+
+
+/*
+CHANGELOG
+
+03.03.11:
+- simplified scalarProd
+- fixed bug in bfct when user used vars t,Dt
+- now bFactor is used by bfct, bfctAnn, i.e. the static procs
+  addRoot, listofroots are superfluous
+- fixed printlevel/debug message issue in bfct, bfctAnn
+- fixed small issue for zero ideal input in linReduceIdeal
+*/
+
 
 
@@ -242 +256 @@
 "
 {
-  int i; int sp;
   if (size(v)!=size(w))
   {
@@ -249 +262 @@
   else
   {
-    for (i=1; i<=size(v);i++)
-    {
-      sp = sp + v[i]*w[i];
-    }
-  }
-  return(sp);
+    intvec u = transpose(v)*w;
+  }
+  return(u[1]);
 }
 example
@@ -456 +466 @@
     }
   }
+  if (sI == sZeros) // if I=0,0,...,0, we now have one too much by construction due to sort
+  {
+    J = J[1..sZeros];
+  }
   if (remembercoeffs <> 0) { return(list(J,M)); }
   else { return(J); }
@@ -1206 +1220 @@
 }
 
-static proc listofroots (list #)
-{
-  def save = basering;
-  int n = nvars(save);
-  int i;
-  poly p;
-  if (typeof(#[1])=="vector")
-  {
-    vector b = #[1];
-    for (i=1; i<=nrows(b); i++)
-    {
-      p = p + b[i]*(var(1))^(i-1);
-    }
-  }
-  else
-  {
-    p = #[1];
-  }
-  int substitution = int(#[2]);
-  string s = safeVarName("s");
-  list RL = ringlist(save); RL = RL[1..4];
-  RL[2] = list(s); RL[3] = list(list("dp",intvec(1)),list("C",0));
-  def S = ring(RL); setring S;
-  ideal J;
-  for (i=1; i<=n; i++)
-  {
-    J[i] = var(1);
-  }
-  map @m = save,J;
-  poly p = @m(p);
-  if (substitution == 1)
-  {
-    p = subst(p,var(1),-var(1)-1);
-  }
-  // the rest of this proc is nicked from bernsteinBM from dmod.lib
-  list P = factorize(p);//with constants and multiplicities
-  ideal bs; intvec m;   //the BS polynomial is monic, so we are not interested in constants
-  for (i=2; i<= size(P[1]); i++)  //we delete P[1][1] and P[2][1]
-  {
-    bs[i-1] = P[1][i];
-    m[i-1]  = P[2][i];
-  }
-  bs =  normalize(bs);
-  bs = -subst(bs,var(1),0);
-  setring save;
-  ideal bs = imap(S,bs);
-  kill S;
-  list BS = bs,m;
-  return(BS);
-}
-
-static proc addRoot(number q, list L)
-{
-  // add root to list in bFactor format
-  int i,qInL;
-  ideal I = L[1];
-  intvec v = L[2];
-  list LL;
-  if (v == 0)
-  {
-    I = poly(q);
-    v = 1;
-    LL = I,v;
-  }
-  else
-  {
-    for (i=1; i<=ncols(I); i++)
-    {
-      if (I[i] == q)
-      {
-        qInL = i;
-        break;
-      }
-    }
-    if (qInL)
-    {
-      v[qInL] = v[qInL] + 1;
-    }
-    else
-    {
-      I = q,I;
-      v = 1,v;
-    }
-  }
-  LL = I,v;
-  if (size(L) == 3) // irreducible factor
-  {
-    if (L[3] <> "0" && L[3] <> "1")
-    {
-      LL = LL + list(L[3]);
-    }
-  }
-  return(LL);
-}
+/*
+// // listofroots and addRoots aren't needed anymore due to some modifications
+//
+// static proc listofroots (list #)
+// {
+//   def save = basering;
+//   int n = nvars(save);
+//   int i;
+//   poly p;
+//   if (typeof(#[1])=="vector")
+//   {
+//     vector b = #[1];
+//     for (i=1; i<=nrows(b); i++)
+//     {
+//       p = p + b[i]*(var(1))^(i-1);
+//     }
+//   }
+//   else
+//   {
+//     p = #[1];
+//   }
+//   int substitution = int(#[2]);
+//   string s = safeVarName("s");
+//   list RL = ringlist(save); RL = RL[1..4];
+//   RL[2] = list(s); RL[3] = list(list("dp",intvec(1)),list("C",0));
+//   def S = ring(RL); setring S;
+//   ideal J;
+//   for (i=1; i<=n; i++)
+//   {
+//     J[i] = var(1);
+//   }
+//   map @m = save,J;
+//   poly p = @m(p);
+//   if (substitution == 1)
+//   {
+//     p = subst(p,var(1),-var(1)-1);
+//   }
+//   // the rest of this proc is nicked from bernsteinBM from dmod.lib
+//   list P = factorize(p);//with constants and multiplicities
+//   ideal bs; intvec m;   //the BS polynomial is monic, so we are not interested in constants
+//   for (i=2; i<= size(P[1]); i++)  //we delete P[1][1] and P[2][1]
+//   {
+//     bs[i-1] = P[1][i];
+//     m[i-1]  = P[2][i];
+//   }
+//   bs =  normalize(bs);
+//   bs = -subst(bs,var(1),0);
+//   setring save;
+//   ideal bs = imap(S,bs);
+//   kill S;
+//   list BS = bs,m;
+//   return(BS);
+// }
+//
+//
+// static proc addRoot(number q, list L)
+// {
+//   // add root to list in bFactor format
+//   int i,qInL;
+//   ideal I = L[1];
+//   intvec v = L[2];
+//   list LL;
+//   if (v == 0)
+//   {
+//     I = poly(q);
+//     v = 1;
+//     LL = I,v;
+//   }
+//   else
+//   {
+//     for (i=1; i<=ncols(I); i++)
+//     {
+//       if (I[i] == q)
+//       {
+//         qInL = i;
+//         break;
+//       }
+//     }
+//     if (qInL)
+//     {
+//       v[qInL] = v[qInL] + 1;
+//     }
+//     else
+//     {
+//       I = q,I;
+//       v = 1,v;
+//     }
+//   }
+//   LL = I,v;
+//   if (size(L) == 3) // irreducible factor
+//   {
+//     if (L[3] <> "0" && L[3] <> "1")
+//     {
+//       LL = LL + list(L[3]);
+//     }
+//   }
+//   return(LL);
+// }
+*/
 
 static proc bfctengine (poly f, int inorann, int whichengine, int addPD, int stdsum, int methodord, int methodpIntersect, int pIntersectchar, int modengine, intvec u0)
 {
-  int ppl = printlevel - voice +2;
+  int printlevelsave = printlevel;
+  printlevel = printlevel + 1;
+  int ppl = printlevel - voice + 2;
   int i;
   def save = basering;
@@ -1335 +1356 @@
     setring newr;
     poly f = imap(save,f);
+    dbprint(ppl,"// starting computation of the initial ideal of the Malgrange ideal...");
     def D = initialMalgrange(f,whichengine,methodord,u0);
+    dbprint(ppl,"// ...done");
     setring D;
     ideal J = inF;
     kill inF;
-    poly s = t*Dt;
+    poly s = var(1)*var(n+2);
   }
   else // bfct using Ann(f^s)
   {
+    dbprint(ppl,"// starting computation of the s-parametric annihilator...");
     def D = SannfsBFCT(f,addPD,whichengine,stdsum);
+    dbprint(ppl,"// ...done");
     setring D;
     ideal J = LD;
@@ -1350 +1375 @@
   }
   vector b;
+  dbprint(ppl,"// starting to intersect with subalgebra...");
   // try it modular
   if (methodpIntersect <> 0) // pIntersectSyz
@@ -1413 +1439 @@
     b = pIntersect(s,J);
   }
-  if (inorann == 0) { list l = listofroots(b,1); }
+  dbprint(ppl,"// ...done"); // with the intersection
+  poly pb = vec2poly(b);
+  if (inorann == 0) 
+  {
+    pb = subst(pb,var(1),-var(1)-1);
+  }
   else // bfctAnn
   {
-    list l = listofroots(b,0);
     if (addPD)
     {
-      l = addRoot(-1,l);
-    }
-  }
+      pb = pb*(var(1)+1);
+    }
+  }
+  list l = bFactor(pb);
   setring save;
   list l = imap(D,l);
+  printlevel = printlevelsave;
   return(l);
 }
@@ -1530 +1562 @@
   int whichengine = 0; // default
   int methodord   = 0; // default
-  int pIntersectchar  = 0; // default
+  int pIntersectchar = 0; // default
   int modengine   = 1; // default
   intvec u0       = 0; // default
@@ -1821 +1853 @@
   ideal I = @m(I);
   poly p = I[1];
-  list l = listofroots(p,1);
+  p = subst(p,var(1),-var(1)-1);
+  list l = bFactor(p);
   if (qr == 1)
   {

Singular/LIB/fpadim.lib

@@ -38 +38 @@
 @*      on. The monomial x_1*x_3*x_2 for example will be stored as (1,3,2).
 @*      Multiplication is concatenation. Note that there is no algorithm for
-@*      computing the normal form yet, but for our case it is not needed.
+@*      computing the normal form needed for our case.
 @*
 
@@ -64 +64 @@
 ivHilbert(L,n[,d]);        computes the Hilbert series of A/<L> in intvec format
 ivKDim(L,n[,d]);           computes the K-dimension of A/<L> in intvec format
+ivMis2Base(M);             computes a K-basis of the factor algebra
 ivMis2Dim(M);              computes the K-dimension of the factor algebra
 ivOrdMisLex(M);            orders a list of intvecs lexicographically
@@ -74 +75 @@
 lpDimCheck(G);             checks if the K-dimension of A/<G> is infinite
 lpKDim(G[,d,n]);           computes the K-dimension of A/<G> in lp format
+lpMis2Base(M);             computes a K-basis of the factor algebra
 lpMis2Dim(M);              computes the K-dimension of the factor algebra
 lpOrdMisLex(M);            orders an ideal of lp-monomials lexicographically
@@ -164 +166 @@
 "PURPOSE:checks, if all entries in M are variable-related
 "
-{int i,j;
+{if ((nrows(M) == 1) && (ncols(M) == 1)) {if (M[1,1] == 0){return(0);}}
+ int i,j;
   for (i = 1; i <= nrows(M); i++)
   {for (j = 1; j <= ncols(M); j++)
@@ -1229 +1232 @@
 }
 
+proc ivMis2Base(list M)
+"USAGE: ivMis2Base(M); M a list of intvecs
+RETURN: ideal, a K-base of the given algebra
+PURPOSE:Computing the K-base out of given mistletoes
+ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
+@*        Otherwise there might some elements missing.
+@*      - basering is a Letterplace ring.
+EXAMPLE: example ivMis2Base; shows examples
+"
+{
+//checkAssumptions(0,M);
+  intvec L,A;
+  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
+  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore 1 is the only basis element"); return(list(intvec(0)));}
+  int i,j,d,s;
+  list Rt;
+  Rt[1] = intvec(0);
+  L = M[1];
+  for (i = size(L); 1 <= i; i--) {Rt = insert(Rt,intvec(L[1..i]));}
+  for (i = 2; i <= size(M); i++)
+  {A = M[i]; L = M[i-1];
+   s = size(A);
+   if (s > size(L))
+   {d = size(L);
+    for (j = s; j > d; j--) {Rt = insert(Rt,intvec(A[1..j]));}
+    A = A[1..d];
+   }
+   if (size(L) > s){L = L[1..s];}
+   while (A <> L)
+   {Rt = insert(Rt, intvec(A));
+    if (size(A) > 1)
+    {A = A[1..(size(A)-1)];
+     L = L[1..(size(L)-1)];
+    }
+    else {break;}
+   }
+  }
+  return(Rt);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y),dp;
+  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
+  R;
+  setring R; // sets basering to Letterplace ring
+  intvec i1 = 1,2; intvec i2 = 2,1,2;
+  // the mistletoes are xy and yxy, which are already ordered lexicographically
+  list L = i1,i2;
+  ivMis2Base(L); // returns the basis of the factor algebra
+}
+
+
 proc ivMis2Dim(list M)
 "USAGE: ivMis2Dim(M); M a list of intvecs
@@ -1595 +1651 @@
 @*        degbound <= attrib(basering,uptodeg) holds.
 NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
-@*      L[2] is an intvec, the Hilbert series and L[3] is an ideal,
+@*      L[2] is an intvec, the Hilbert series and L[3] is an ideal, 
 @*      the mistletoes
 @*    - If degbound is set, there will be a degree bound added. 0 means no
@@ -1729 +1785 @@
   // ring is not necessary
   lpKDim(G,0); // procedure without any degree bound
+}
+
+proc lpMis2Base(ideal M)
+"USAGE: lpMis2Base(M); M an ideal
+RETURN: ideal, a K-basis of the factor algebra
+PURPOSE:Computing a K-basis out of given mistletoes
+ASSUME: - basering is a Letterplace ring.
+@*      - M contains only monomials
+NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
+EXAMPLE: example lpMis2Base; shows examples
+"
+{list L;
+  L = lpId2ivLi(M);
+  return(ivL2lpI(ivMis2Base(L)));
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y),dp;
+  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
+  setring R; // sets basering to Letterplace ring
+  ideal L = x(1)*y(2),y(1)*x(2)*y(3);
+  // ideal containing the mistletoes
+  lpMis2Base(L); // returns the K-basis of the factor algebra
 }
 
@@ -1968 +2048 @@
   example ivHilbert;
   example ivKDim;
+  example ivMis2Base;
   example ivMis2Dim;
   example ivOrdMisLex;
@@ -1978 +2059 @@
   example lpDimCheck;
   example lpKDim;
+  example lpMis2Base;
   example lpMis2Dim;
   example lpOrdMisLex;

Singular/LIB/ncfactor.lib

@@ -1894 +1894 @@
   dbprint(p,"==> Deleting double entries in the resulting list.");
   result = delete_dublicates_noteval(result);
+  if (size(result)==0)
+  {//only the trivial factorization could be found
+    result = list(list(1,h));
+  }//only the trivial factorization could be found
   return(result);
 }//proc facshift
@@ -1968 +1972 @@
   isEqualList(m,l);
 }
+
+
+//////////////////////////////////////////////////
+// Q-WEYL-SECTION
+//////////////////////////////////////////////////
+
+//==================================================
+//A function to get the i'th triangular number
+proc triangNum(int n)
+{
+     if (n == 0)
+     {
+          return(0);
+     }
+     return (n*(n+1)/2);
+}
+
+//==================================================*
+//one factorization of a homogeneous polynomial
+//in the first Q Weyl Algebra
+proc homogfacFirstQWeyl(poly h)
+"USAGE: homogfacFirstQWeyl(h); h is a homogeneous polynomial in the
+        first q-Weyl algebra with respect to the weight vector [-1,1]
+RETURN: list
+PURPOSE: Computes a factorization of a homogeneous polynomial h with
+         respect to the weight vector [-1,1] in the first q-Weyl algebra
+THEORY: @code{homogfacFirstQWeyl} returns a list with a factorization of the given,
+        [-1,1]-homogeneous polynomial. If the degree of the polynomial is k with
+        k positive, the last k entries in the output list are the second
+        variable. If k is positive, the last k entries will be x. The other
+        entries will be irreducible polynomials of degree zero or 1 resp. -1.
+SEE ALSO: homogfacFirstWeyl
+"{//proc homogfacFirstQWeyl
+  int p = printlevel-voice+2;//for dbprint
+  def r = basering;
+  poly hath;
+  int i; int j;
+  intvec ivm11 = intvec(-1,1);
+  if (!homogwithorder(h,ivm11))
+  {//The given polynomial is not homogeneous
+    ERROR("Given polynomial was not [-1,1]-homogeneous");
+    return(list());
+  }//The given polynomial is not homogeneous
+  if (h==0)
+  {
+    return(list(0));
+  }
+  list result;
+  int m = deg(h,ivm11);
+  dbprint(p,"==> Splitting the polynomial in A_0 and A_k-Part");
+  if (m!=0)
+  {//The degree is not zero
+    if (m <0)
+    {//There are more x than y
+      hath = lift(var(1)^(-m),h)[1,1];
+      for (i = 1; i<=-m; i++)
+      {
+        result = result + list(var(1));
+      }
+    }//There are more x than y
+    else
+    {//There are more y than x
+      hath = lift(var(2)^m,h)[1,1];
+      for (i = 1; i<=m;i++)
+      {
+        result = result + list(var(2));
+      }
+    }//There are more y than x
+  }//The degree is not zero
+  else
+  {//The degree is zero
+    hath = h;
+  }//The degree is zero
+  dbprint(p,"==> Done");
+  //beginning to transform x^i*y^i in theta(theta-1)...(theta-i+1)
+  list mons;
+  dbprint(p,"==> Putting the monomials in the A_0-part in a list.");
+  for(i = 1; i<=size(hath);i++)
+  {//Putting the monomials in a list
+    mons = mons+list(hath[i]);
+  }//Putting the monomials in a list
+  dbprint(p,"==> Done");
+  dbprint(p,"==> Mapping this monomials to K(q)[theta]");
+  def characteristic = ringlist(r)[1][1];
+  def qparameter      = ringlist(r)[1][2][1];
+  ring tempRing = (characteristic,q),(x,y,theta),dp; //TODO: How to map a parameter?
+  setring tempRing;
+  map thetamap = r,x,y;
+  list mons = thetamap(mons);
+  poly entry;
+  poly tempSummand;
+  for (i = 1; i<=size(mons);i++)
+  {//transforming the monomials as monomials in theta
+       entry = 1; //leadcoef(mons[i]) * q^(-triangNum(leadexp(mons[i])[2]-1));
+    for (j = 0; j<leadexp(mons[i])[2];j++)
+    {
+//"j:";j;
+         tempSummand = (q^j-1)/(q-1);
+         entry = entry * theta-tempSummand*entry;
+    }
+//~;   
+ mons[i] = entry*leadcoef(mons[i]) * q^(-triangNum(leadexp(mons[i])[2]-1));
+  }//transforming the monomials as monomials in theta
+  dbprint(p,"==> Done");
+  dbprint(p,"==> Factorize the A_0-Part in K[theta]");
+  list azeroresult = factorize(sum(mons));
+  dbprint(p,"==> Successful");
+  list azeroresult_return_form;
+  for (i = 1; i<=size(azeroresult[1]);i++)
+  {//rewrite the result of the commutative factorization
+    for (j = 1; j <= azeroresult[2][i];j++)
+    {
+      azeroresult_return_form = azeroresult_return_form + list(azeroresult[1][i]);
+    }
+  }//rewrite the result of the commutative factorization
+  dbprint(p,"==> Mapping back to A_0.");
+  setring(r);
+  map finalmap = tempRing,var(1),var(2),var(1)*var(2);
+  list tempresult = finalmap(azeroresult_return_form);
+  dbprint(p,"Successful.");
+  for (i = 1; i<=size(tempresult);i++)
+  {//factorizations of theta resp. theta +1
+    if(tempresult[i]==var(1)*var(2))
+    {
+      tempresult = insert(tempresult,var(1),i-1);
+      i++;
+      tempresult[i]=var(2);
+    }
+    if(tempresult[i]==var(2)*var(1))
+    {
+      tempresult = insert(tempresult,var(2),i-1);
+      i++;
+      tempresult[i]=var(1);
+    }
+  }//factorizations of theta resp. theta +1
+  result = tempresult+result;
+  //Correction of the result in the special q-Case:
+  for (j = 2 ; j<= size(result);j++)
+  {//Divide the whole Term by the leading coefficient and multiply it to the first entry in result[i]
+       result[1] = result[1] * leadcoef(result[j]);
+       result[j] = 1/leadcoef(result[j]) * result[j];
+  }//Divide the whole Term by the leading coefficient and multiply it to the first entry in result[i]
+  return(result);
+}//proc homogfacFirstQWeyl
+
+
+
+//==================================================
+//Computes all possible homogeneous factorizations for an element in the first Q-Weyl Algebra
+proc homogfacFirstQWeyl_all(poly h)
+"USAGE: homogfacFirstWWeyl_all(h); h is a homogeneous polynomial in the first q-Weyl algebra
+        with respect to the weight vector [-1,1]
+RETURN: list
+PURPOSE: Computes all factorizations of a homogeneous polynomial h with respect
+         to the weight vector [-1,1] in the first q-Weyl algebra
+THEORY: @code{homogfacFirstQWeyl} returns a list with all factorization of the given,
+        homogeneous polynomial. It uses the output of homogfacFirstQWeyl and permutes
+        its entries with respect to the commutation rule. Furthermore, if a
+        factor of degree zero is irreducible in K[\theta], but reducible in
+        the first q-Weyl algebra, the permutations of this element with the other
+        entries will also be computed.
+SEE ALSO: homogfacFirstWeyl
+"{//proc HomogfacFirstQWeylAll
+  int p=printlevel-voice+2;//for dbprint
+  intvec iv11= intvec(1,1);
+  if (deg(h,iv11) <= 0 )
+  {//h is a constant
+    dbprint(p,"Given polynomial was not homogeneous");
+    return(list(list(h)));
+  }//h is a constant
+  def r = basering;
+  list one_hom_fac; //stands for one homogeneous factorization
+  int i; int j; int k;
+  intvec ivm11 = intvec(-1,1);
+  dbprint(p,"==> Calculate one homogeneous factorization using homogfacFirstQWeyl");
+  //Compute again a homogeneous factorization
+  one_hom_fac = homogfacFirstQWeyl(h);
+  dbprint(p,"Successful");
+  if (size(one_hom_fac) == 0)
+  {//there is no homogeneous factorization or the polynomial was not homogeneous
+    return(list());
+  }//there is no homogeneous factorization or the polynomial was not homogeneous
+  //divide list in A0-Part and a list of x's resp. y's
+  list list_not_azero = list();
+  list list_azero;
+  list k_factor;
+  int is_list_not_azero_empty = 1;
+  int is_list_azero_empty = 1;
+  k_factor = list(one_hom_fac[1]);
+  if (absValue(deg(h,ivm11))<size(one_hom_fac)-1)
+  {//There is a nontrivial A_0-part
+    list_azero = one_hom_fac[2..(size(one_hom_fac)-absValue(deg(h,ivm11)))];
+    is_list_azero_empty = 0;
+  }//There is a nontrivial A_0 part
+  dbprint(p,"==> Combine x,y to xy in the factorization again.");
+  for (i = 1; i<=size(list_azero)-1;i++)
+  {//in homogfacFirstQWeyl, we factorized theta, and this will be made undone
+    if (list_azero[i] == var(1))
+    {
+      if (list_azero[i+1]==var(2))
+      {
+        list_azero[i] = var(1)*var(2);
+        list_azero = delete(list_azero,i+1);
+      }
+    }
+    if (list_azero[i] == var(2))
+    {
+      if (list_azero[i+1]==var(1))
+      {
+        list_azero[i] = var(2)*var(1);
+        list_azero = delete(list_azero,i+1);
+      }
+    }
+  }//in homogfacFirstQWeyl, we factorized theta, and this will be made undone
+  dbprint(p,"==> Done");
+  if(deg(h,ivm11)!=0)
+  {//list_not_azero is not empty
+    list_not_azero =
+      one_hom_fac[(size(one_hom_fac)-absValue(deg(h,ivm11))+1)..size(one_hom_fac)];
+    is_list_not_azero_empty = 0;
+  }//list_not_azero is not empty
+  //Map list_azero in K[theta]
+  dbprint(p,"==> Map list_azero to K[theta]");
+  def characteristic = ringlist(r)[1][1];
+  def qparameter      = ringlist(r)[1][2][1];
+  ring tempRing = (characteristic,q),(x,y,theta),dp; //TODO: How to map a parameter?
+  setring(tempRing);
+  poly entry;
+  map thetamap = r,x,y;
+  if(!is_list_not_azero_empty)
+  {//Mapping in Singular is only possible, if the list before
+    //contained at least one element of the other ring
+    list list_not_azero = thetamap(list_not_azero);
+  }//Mapping in Singular is only possible, if the list before
+  //contained at least one element of the other ring
+  if(!is_list_azero_empty)
+  {//Mapping in Singular is only possible, if the list before
+    //contained at least one element of the other ring
+    list list_azero= thetamap(list_azero);
+  }//Mapping in Singular is only possible, if the list before
+  //contained at least one element of the other ring
+  list k_factor = thetamap(k_factor);
+  list tempmons;
+  dbprint(p,"==> Done");
+  for(i = 1; i<=size(list_azero);i++)
+  {//rewrite the polynomials in A1 as polynomials in K[theta]
+    tempmons = list();
+    for (j = 1; j<=size(list_azero[i]);j++)
+    {
+      tempmons = tempmons + list(list_azero[i][j]);
+    }
+    for (j = 1 ; j<=size(tempmons);j++)
+    {
+         //entry = leadcoef(tempmons[j]);
+         entry = leadcoef(tempmons[j]) * q^(-triangNum(leadexp(tempmons[j])[2]-1));
+      for (k = 0; k < leadexp(tempmons[j])[2];k++)
+      {
+           entry = entry*(theta-(q^k-1)/(q-1));
+      }
+      tempmons[j] = entry;
+    }
+    list_azero[i] = sum(tempmons);
+  }//rewrite the polynomials in A1 as polynomials in K[theta]
+  //Compute all permutations of the A0-part
+  dbprint(p,"==> Compute all permutations of the A_0-part with the first resp. the snd. variable");
+  list result;
+  int shift_sign;
+  int shift;
+  poly shiftvar;
+  if (size(list_not_azero)!=0)
+  {//Compute all possibilities to permute the x's resp. the y's in the list
+    if (list_not_azero[1] == x)
+    {//h had a negative weighted degree
+      shift_sign = 1;
+      shiftvar = x;
+    }//h had a negative weighted degree
+    else
+    {//h had a positive weighted degree
+      shift_sign = -1;
+      shiftvar = y;
+    }//h had a positive weighted degree
+    result = permpp(list_azero + list_not_azero);
+    for (i = 1; i<= size(result); i++)
+    {//adjust the a_0-parts
+      shift = 0;
+      for (j=1; j<=size(result[i]);j++)
+      {
+        if (result[i][j]==shiftvar)
+        {
+          shift = shift + shift_sign;
+        }
+        else
+        {
+             if (shift < 0)
+             {//We have two distict formulas for x and y. In this case use formula for y
+                  if (shift == -1)
+                  {
+                       result[i][j] = subst(result[i][j],theta,1/q*(theta - 1));
+                  }
+                  else
+                  {
+                       result[i][j] = subst(result[i][j],theta,1/q*((theta - 1)/q^(absValue(shift)-1) - (q^(shift +2)-q)/(1-q)));
+                  }
+             }//We have two distict formulas for x and y. In this case use formula for y
+             if (shift > 0)
+             {//We have two distict formulas for x and y. In this case use formula for x
+                  if (shift == 1)
+                  {
+                       result[i][j] = subst(result[i][j],theta,q*theta + 1);
+                  }
+                  else
+                  {
+                       result[i][j] = subst(result[i][j],theta,q^shift*theta+(q^shift-1)/(q-1));
+                  }
+             }//We have two distict formulas for x and y. In this case use formula for x
+        }
+      }
+    }//adjust the a_0-parts
+  }//Compute all possibilities to permute the x's resp. the y's in the list
+  else
+  {//The result is just all the permutations of the a_0-part
+    result = permpp(list_azero);
+  }//The result is just all the permutations of the a_0 part
+  if (size(result)==0)
+  {
+    return(result);
+  }
+  dbprint(p,"==> Done");
+  dbprint(p,"==> Searching for theta resp. theta + 1 in the list and factorize them");
+  //Now we are going deeper and search for theta resp. theta + 1, substitute
+  //them by xy resp. yx and go on permuting
+  int found_theta;
+  int thetapos;
+  list leftpart;
+  list rightpart;
+  list lparts;
+  list rparts;
+  list tempadd;
+  for (i = 1; i<=size(result) ; i++)
+  {//checking every entry of result for theta or theta +1
+    found_theta = 0;
+    for(j=1;j<=size(result[i]);j++)
+    {
+      if (result[i][j]==theta)
+      {//the jth entry is theta and can be written as x*y
+        thetapos = j;
+        result[i]= insert(result[i],x,j-1);
+        j++;
+        result[i][j] = y;
+        found_theta = 1;
+        break;
+      }//the jth entry is theta and can be written as x*y
+      if(result[i][j] == q*theta +1)
+      {
+        thetapos = j;
+        result[i] = insert(result[i],y,j-1);
+        j++;
+        result[i][j] = x;
+        found_theta = 1;
+        break;
+      }
+    }
+    if (found_theta)
+    {//One entry was theta resp. theta +1
+      leftpart = result[i];
+      leftpart = leftpart[1..thetapos];
+      rightpart = result[i];
+      rightpart = rightpart[(thetapos+1)..size(rightpart)];
+      lparts = list(leftpart);
+      rparts = list(rightpart);
+      //first deal with the left part
+      if (leftpart[thetapos] == x)
+      {
+        shift_sign = 1;
+        shiftvar = x;
+      }
+      else
+      {
+        shift_sign = -1;
+        shiftvar = y;
+      }
+      for (j = size(leftpart); j>1;j--)
+      {//drip x resp. y
+        if (leftpart[j-1]==shiftvar)
+        {//commutative
+          j--;
+          continue;
+        }//commutative
+        if (deg(leftpart[j-1],intvec(-1,1,0))!=0)
+        {//stop here
+          break;
+        }//stop here
+        //Here, we can only have a a0- part
+        if (shift_sign<0)
+        {
+             leftpart[j] = subst(leftpart[j-1],theta, 1/q*(theta +shift_sign));
+        }
+        if (shift_sign>0)
+        {
+             leftpart[j] = subst(leftpart[j-1],theta, q*theta + shift_sign);
+        }
+        leftpart[j-1] = shiftvar;
+        lparts = lparts + list(leftpart);
+      }//drip x resp. y
+      //and now deal with the right part
+      if (rightpart[1] == x)
+      {
+        shift_sign = 1;
+        shiftvar = x;
+      }
+      else
+      {
+        shift_sign = -1;
+        shiftvar = y;
+      }
+      for (j = 1 ; j < size(rightpart); j++)
+      {
+        if (rightpart[j+1] == shiftvar)
+        {
+          j++;
+          continue;
+        }
+        if (deg(rightpart[j+1],intvec(-1,1,0))!=0)
+        {
+          break;
+        }
+        if (shift_sign<0)
+        {
+             rightpart[j] = subst(rightpart[j+1], theta, q*theta - shift_sign);
+        }
+        if (shift_sign>0)
+        {
+             rightpart[j] = subst(rightpart[j+1], theta, 1/q*(theta - shift_sign));
+        }
+        rightpart[j+1] = shiftvar;
+        rparts = rparts + list(rightpart);
+      }
+      //And now, we put all possibilities together
+      tempadd = list();
+      for (j = 1; j<=size(lparts); j++)
+      {
+        for (k = 1; k<=size(rparts);k++)
+        {
+          tempadd = tempadd + list(lparts[j]+rparts[k]);
+        }
+      }
+      tempadd = delete(tempadd,1); // The first entry is already in the list
+      result = result + tempadd;
+      continue; //We can may be not be done already with the ith entry
+    }//One entry was theta resp. theta +1
+  }//checking every entry of result for theta or theta +1
+  dbprint(p,"==> Done");
+  //map back to the basering
+  dbprint(p,"==> Mapping back everything to the basering");
+  setring(r);
+  map finalmap = tempRing, var(1), var(2),var(1)*var(2);
+  list result = finalmap(result);
+  for (i=1; i<=size(result);i++)
+  {//adding the K factor
+    result[i] = k_factor + result[i];
+  }//adding the k-factor
+  dbprint(p,"==> Done");
+  dbprint(p,"==> Delete double entries in the list.");
+  result = delete_dublicates_noteval(result);
+  dbprint(p,"==> Done");
+  return(result);
+}//proc HomogfacFirstQWeylAll
+
+//TODO: FirstQWeyl check the parameters...
 
 /*