source: git/Singular/LIB/fpalgebras.lib @ c47d823

////////////////////////////////////////////////////////////////
version="version fpalgebras.lib 4.1.1.4 Oct_2018 "; // $Id$
category="Noncommutative";
info="
LIBRARY: fpalgebras.lib    Definitions of some finitely presented algebras and groups (Letterplace)
AUTHORS: Karim Abou Zeid,       karim.abou.zeid at rwth-aachen.de@*
         Viktor Levandovskyy,   viktor.levandovskyy at math.rwth-aachen.de@*
         Grischa Studzinski,    grischa.studzinski at rwth-aachen.de

Support: Project II.6 in the transregional collaborative research centre
SFB-TRR 195 'Symbolic Tools in Mathematics and their Application' of the German DFG

OVERVIEW:
Generation of various algebras, including group algebras of finitely presented groups in the Letterplace ring.
FPA stands for finitely presented algebra.

KEYWORDS: free associative algebra; finitely presented algebra; finitely presented group; Serre relations

PROCEDURES:
operatorAlgebra(string a, int d); description of some common algebras of operators
serreRelations(A,z); compute the homogeneous part of Serre's relations associated to a generalized Cartan matrix A
fullSerreRelations(A,N,C,P,d); compute the ideal of all Serre's relations associated to a generalized Cartan matrix A
ademRelations(i,j);    compute the ideal of Adem relations for i<2j in char 0
baumslagSolitar(int n, int m, int d, list #);
baumslagGroup(int m, int n, int d);
crystallographicGroupP1(int d);
crystallographicGroupPM(int d);
crystallographicGroupPG(int d);
crystallographicGroupP2MM(int d);
crystallographicGroupP2(int d);
crystallographicGroupP2GG(int d);
crystallographicGroupCM(int d);
crystallographicGroupC2MM(int d);
crystallographicGroupP4(int d);
crystallographicGroupP4MM(int d);
crystallographicGroupP4GM(int d);
crystallographicGroupP3(int d);
crystallographicGroupP31M(int d);
crystallographicGroupP3M1(int d);
crystallographicGroupP6(int d);
crystallographicGroupP6MM(int d);
dyckGroup1(int n, int d, intvec P);
dyckGroup2(int n, int d, intvec P);
dyckGroup3(int n, int d, intvec P);
fibonacciGroup(int m, int d);
tetrahedronGroup(int g, int d);
triangularGroup(int g, int d);

SEE ALSO: freegb_lib, fpadim_lib, fpaprops_lib, LETTERPLACE
";

LIB "freegb.lib";
LIB "general.lib";
////////////////////////////////////////////////////////////////////

/* very fast and cheap test of consistency and functionality
  DO NOT make it static !
  after adding the new proc, add it here */
proc tstfpalgebras()
{
  example operatorAlgebra;
  example serreRelations;
  example fullSerreRelations;
  example ademRelations;
  example baumslagSolitar;
  example baumslagGroup;
  example dyckGroup1;
  example dyckGroup2;
  example dyckGroup3;
  example fibonacciGroup;
  example tetrahedronGroup;
  example triangularGroup;
};

// Serre and Adem
proc serreRelations(intmat A, int zu)
"USAGE:  serreRelations(A,z); A an intmat, z an int
RETURN:  ideal
ASSUME: basering has a letterplace ring structure and
@*          A is a generalized Cartan matrix with integer entries
PURPOSE: compute the ideal of Serre's relations associated to A
EXAMPLE: example serreRelations; shows examples
"
{
  // zu = 1 -> with commutators [f_i,f_j]; zu == 0 without them
  // suppose that A is cartan matrix
  // then Serre's relations are
  // (ad f_j)^{1-A_{ij}} ( f_i)
  int ppl = printlevel-voice+2;
  int n = ncols(A); // hence n variables
  int i,j,k,el;
  poly p,q;
  ideal I;
  for (i=1; i<=n; i++)
  {
    for (j=1; j<=n; j++)
    {
      el = 1 - A[i,j];
      //     printf("i:%s, j: %s, l: %s",i,j,l);
      dbprint(ppl,"i, j, l: ",i,j,el);
      //      if ((i!=j) && (l >0))
      //      if ( (i!=j) &&  ( ((zu ==0) &&  (l >=2)) || ((zu ==1) &&  (l >=1)) ) )
      if ((i!=j) && (el >0))
      {
        q = lieBracket(var(j),var(i));
        dbprint(ppl,"first bracket: ",q);
        //        if (l >=2)
        //        {
          for (k=1; k<=el-1; k++)
          {
            q = lieBracket(var(j),q);
            dbprint(ppl,"further bracket:",q);
          }
          //        }
      }
      if (q!=0) { I = I,q; q=0;}
    }
  }
  I = simplify(I,2);
  return(I);
}
example
{
  "EXAMPLE:"; echo = 2;
  intmat A[3][3] =
    2, -1, 0,
    -1, 2, -3,
    0, -1, 2; // G^1_2 Cartan matrix
  ring r = 0,(f1,f2,f3),dp;
  int uptodeg = 5;
  def R = makeLetterplaceRing(uptodeg);
  setring R;
  ideal I = serreRelations(A,1); I = simplify(I,1+2+8);
  I;
}

/* setup for older example:
  intmat A[2][2] = 2, -1, -1, 2; // sl_3 == A_2
  ring r = 0,(f1,f2),dp;
  int uptodeg = 5; int lV = 2;
*/

proc fullSerreRelations(intmat A, ideal rNegative, ideal rCartan, ideal rPositive, int uptodeg)
"USAGE:  fullSerreRelations(A,N,C,P,d); A an intmat, N,C,P ideals, d an int
RETURN:  ring (and ideal)
PURPOSE: compute the inhomogeneous Serre's relations associated to A in given
@*       variable names
ASSUME: three ideals in the input are of the same sizes and contain merely
@* variables which are interpreted as follows: N resp. P stand for negative
@* resp. positive roots, C stand for Cartan elements. d is the degree bound for
@* letterplace ring, which will be returned.
@* The matrix A is a generalized Cartan matrix with integer entries
@* The result is the ideal called 'fsRel' in the returned ring.
EXAMPLE: example fullSerreRelations; shows examples
"
{
  /* SerreRels on rNeg and rPos plus Cartans etc. */
  int ppl = printlevel -voice+2;
  /* ideals must be written in variables: assume each term is of degree 1 */
  int i,j,k;
  int N = nvars(basering);
  def save = basering;
  int comFlag = 0;
  /* assume:  (size(rNegative) == size(rPositive)) */
  /* assume:  (size(rNegative) == size(rCartan)) i.e. nonsimple Cartans */
  if ( (size(rNegative) != size(rPositive)) || (size(rNegative) != size(rCartan)) )
  {
    ERROR("All input ideals must be of the same size");
  }

//   if (size(rNegative) != size(rPositive))
//   {
//     ERROR("The 1st and the 3rd input ideals must be of the same size");
//   }

  /* assume:  2*size(rNegative) + size(rCartan) >= nvars(basering) */
  i = 2*size(rNegative) + size(rCartan);
  if (i>N)
  {
    string s1="The total number of elements in input ideals";
    string s2="must not exceed the dimension of the ground ring";
    ERROR(s1+s2);
  }
  if (i < N)
  {
    comFlag = N-i; // so many elements will commute
    "Warning: some elements will be treated as mutually commuting";
  }
  /* extract varnames from input ideals */
  intvec iNeg = varIdeal2intvec(rNegative);
  intvec iCartan = varIdeal2intvec(rCartan);
  intvec iPos = varIdeal2intvec(rPositive);
  /* for each vector in rNeg and rPositive, go into the corr. ring and create SerreRels */
  /* rNegative: */
  list L = ringlist(save);
  def LPsave = makeLetterplaceRing(uptodeg); setring save;
  list LNEG = L; list tmp;
  /* L[1] field as is; L[2] vars: a subset; L[3] ordering: dp, L[4] as is */
  for (i=1; i<=size(iNeg); i++)
  {
    tmp[i] = string(var(iNeg[i]));
  }
  LNEG[2] = tmp; LNEG[3] = list(list("dp",intvec(1:size(iNeg))), list("C",0));
  def RNEG = ring(LNEG); setring RNEG;
  def RRNEG = makeLetterplaceRing(uptodeg);
  setring RRNEG;
  ideal I = serreRelations(A,1); I = simplify(I,1+2+8);
  setring LPsave;
  ideal srNeg = imap(RRNEG,I);
  dbprint(ppl,"0-1 ideal of negative relations is ready");
  dbprint(ppl-1,srNeg);
  setring save; kill L,tmp,RRNEG,RNEG, LNEG;
  /* rPositive: */
  list L = ringlist(save);
  list LPOS = L; list tmp;
  /* L[1] field as is; L[2] vars: a subset; L[3] ordering: dp, L[4] as is */
  for (i=1; i<=size(iPos); i++)
  {
    tmp[i] = string(var(iPos[i]));
  }
  LPOS[2] = tmp; LPOS[3] = list(list("dp",intvec(1:size(iPos))), list("C",0));
  def RPOS = ring(LPOS); setring RPOS;
  def RRPOS = makeLetterplaceRing(uptodeg);
  setring RRPOS;
  ideal I = serreRelations(A,1); I = simplify(I,1+2+8);
  setring LPsave;
  ideal srPos = imap(RRPOS,I);
  dbprint(ppl,"0-2 ideal of positive relations is ready");
  dbprint(ppl-1,srPos);
  setring save; kill L,tmp,RRPOS,RPOS, LPOS;
  string sMap = "ideal Mmap =";
  for (i=1; i<=nvars(save); i++)
  {
    sMap = sMap + string(var(i))+",";
  }
  sMap[size(sMap)] = ";";
  /* cartans: h_j h_i = h_i h_j */
  setring LPsave;
  ideal ComCartan;
  for (i=1; i<size(iCartan); i++)
  {
    for (j=i+1; j<=size(iCartan); j++)
    {
      ComCartan =  ComCartan + lieBracket(var(iCartan[j]),var(iCartan[i]));
    }
  }
  ComCartan = simplify(ComCartan,1+2+8);
  execute(sMap); // defines an ideal Mmap
  map F = save, Mmap;
  dbprint(ppl,"1. commuting Cartans: ");
  dbprint(ppl-1,ComCartan);
  /* [e_i, f_j] =0 if i<>j */
  ideal ComPosNeg; // assume: #Neg=#Pos
  for (i=1; i<size(iPos); i++)
  {
    for (j=1; j<=size(iPos); j++)
    {
      if (j !=i)
      {
        ComPosNeg =  ComPosNeg + lieBracket(var(iPos[i]),var(iNeg[j]));
        ComPosNeg =  ComPosNeg + lieBracket(var(iPos[j]),var(iNeg[i]));
      }
    }
  }
  ComPosNeg = simplify(ComPosNeg,1+2+8);
  dbprint(ppl,"2. commuting Positive and Negative:");
  dbprint(ppl-1,ComPosNeg);
  /* [e_i, f_i] = h_i */
  poly tempo;
  for (i=1; i<=size(iCartan); i++)
  {
    tempo = lieBracket(var(iPos[i]),var(iNeg[i])) - var(iCartan[i]);
    ComPosNeg =  ComPosNeg + tempo;
  }
  //  ComPosNeg = simplify(ComPosNeg,1+2+8);
  dbprint(ppl,"3. added sl2 triples [e_i,f_i]=h_i");
  dbprint(ppl-1,ComPosNeg);

  /* [h_i, e_j] = A_ij e_j */
  /* [h_i, f_j] = -A_ij f_j */
  ideal ActCartan; // assume: #Neg=#Pos
  for (i=1; i<=size(iCartan); i++)
  {
    for (j=1; j<=size(iCartan); j++)
    {
      tempo = lieBracket(var(iCartan[i]),var(iPos[j])) - A[i,j]*var(iPos[j]);
      ActCartan = ActCartan + tempo;
      tempo = lieBracket(var(iCartan[i]),var(iNeg[j])) + A[i,j]*var(iNeg[j]);
      ActCartan = ActCartan + tempo;
    }
  }
  ActCartan = simplify(ActCartan,1+2+8);
  dbprint(ppl,"4. actions of Cartan:");
  dbprint(ppl-1, ActCartan);

  /* final part: prepare the output */
  setring LPsave;
  ideal fsRel = srNeg, srPos, ComPosNeg, ComCartan, ActCartan;
  export fsRel;
  setring save;
  return(LPsave);
}
example
{
  "EXAMPLE:"; echo = 2;
  intmat A[2][2] =
    2, -1,
    -1, 2; // A_2 = sl_3 Cartan matrix
  ring r = 0,(f1,f2,h1,h2,e1,e2),dp;
  ideal negroots = f1,f2; ideal cartans = h1,h2; ideal posroots = e1,e2;
  int uptodeg = 5;
  def RS = fullSerreRelations(A,negroots,cartans,posroots,uptodeg);
  setring RS; fsRel;
}

/* intmat A[2][2] =
    2, -1,
    -3, 2; // G_2 Cartan matrix
*/


static proc varIdeal2intvec(ideal I)
{
  // used in SerreRelations
  /* assume1:  input ideal is a list of variables of the ground ring */
  int i,j; intvec V;
  for (i=1; i<= size(I); i++)
  {
    j = univariate(I[i]);
    if (j<=0)
    {
      ERROR("input ideal must contain only variables");
    }
    V[i] = j;
  }
  dbprint(printlevel-voice+2,V);
  /* now we make a smaller list of non-repeating entries */
  ideal iW = simplify(ideal(V),2+4); // no zeros, no repetitions
  if (size(iW) < size(V))
  {
    /* extract intvec from iW */
    intvec inW;
    for(j=1; j<=size(iW); j++)
    {
      inW[j] = int(leadcoef(iW[j]));
    }
    return(inW);
  }
  return(V);
}
example
{
  "EXAMPLE:"; echo = 2;
  ring r = 0,(x,y,z),dp;
  ideal I = x,z;
  varIdeal2intvec(I);
  varIdeal2intvec(ideal(x2,y^3,x+1));
  varIdeal2intvec(ideal(x*y,y,x+1));
}

proc ademRelations(int i, int j)
"USAGE:  ademRelations(i,j); i,j int
RETURN:  ring (and exports ideal)
PURPOSE: compute the ideal of Adem relations for i<2j in characteristic 0
@*  the ideal is exported under the name AdemRel in the output ring
EXAMPLE: example ademRelations; shows examples
"
{
  // produces Adem relations for i<2j in char 0
  // assume: 0<i<2j
  // requires presence of vars up to i+j
  if ( (i<0) || (i >= 2*j) )
  {
    ERROR("arguments out of range"); return(0);
  }
  ring @r = 0,(s(i+j..0)),lp;
  poly p,q;
  number n;
  int ii = i div 2; int k;
  // k=0 => s(0)=1
  n = binomial(j-1,i);
  q = n*s(i+j)*s(0);
  //  printf("k=0, term=%s",q);
  p = p + q;
  for (k=1; k<= ii; k++)
  {
    n = binomial(j-k-1,i-2*k);
    q = n*s(i+j-k)*s(k);;
    //    printf("k=%s, term=%s",k,q);
    p = p + q;
  }
  poly AdemRel = p;
  export AdemRel;
  return(@r);
}
example
{
  "EXAMPLE:"; echo = 2;
  def A = ademRelations(2,5);
  setring A;
  AdemRel;
}

/*
1,1: 0
1,2: s(3)*s(0) == s(3) -> def for s(3):=s(1)s(2)
2,1: adm
2,2: s(3)*s(1) == s(1)s(2)s(1)
1,3: 0 ( since 2*s(4)*s(0) = 0 mod 2)
3,1: adm
2,3: s(5)*s(0)+s(4)*s(1) == s(5)+s(4)*s(1)
3,2: 0
3,3: s(5)*s(1)
1,4: 3*s(5)*s(0) == s(5)  -> def for s(5):=s(1)*s(4)
4,1: adm
2,4: 3*s(6)*s(0)+s(5)*s(1) == s(6) + s(5)*s(1) == s(6) + s(1)*s(4)*s(1)
4,2: adm
4,3: s(5)*s(2)
3,4: s(7)*s(0)+2*s(6)*s(1) == s(7) -> def for s(7):=s(3)*s(4)
4,4: s(7)*s(1)+s(6)*s(2)
*/

/* s1,s2:
s1*s1 =0, s2*s2 = s1*s2*s1
try char 0:
s1,s2:
s1*s1 =0, s2*s2 = s1*s2*s1, s(1)*s(3)== s(1)*s(1)*s(3) == 0 = 2*s(4) ->def for s(4)
hence 2==0! only in char 2
Adem rels modulo 2 are interesting
 */

////////////////////////////////////////////////////////////////////
// Operator Algebras ///////////////////////////////////////////////
////////////////////////////////////////////////////////////////////

proc operatorAlgebra(string a, int d)
"USAGE: operatorAlgebra(a,d); a a string, d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - a gives the name of the algebra
      - d gives the degreebound for the Letterplace ring

      a must be one of the following:
        integrodiff3
        toeplitz
        weyl1
        usl2
        usl2h
        shift1inverse
        exterior2
        quadrowmm
        shift1
        weyl1inverse

      This is a collection of common algebras.
"
{
  if (d < 2) {
    ERROR("Degbound d is too small. Must be at least 2.");
  }
  int baseringdef;
  if (defined(basering)) // if a basering is defined, it should be saved for later use
  {
    def save = basering;
    baseringdef = 1;
  }

  if (a == "integrodiff3") {
    ring r = 0,(D,II,x),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = D*x-x*D-1,
          II*x-x*II+II*II,
          D*II-1;
  }
  if (a == "toeplitz") {
    ring r = 0,(y,x),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = y*x-1;
  }
  if (a == "weyl1") {
    ring r = 0,(D,x),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = D*x-x*D-1;
  }
  if (a == "usl2") {
    ring r = 0,(h,f,e),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = f*e-e*f+h,
          h*e-e*h-2*e,
          h*f-f*h+2*f;
  }
  if (a == "usl2h") {
    ring r = 0,(H,h,f,e),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = f*e-e*f+h*H,
          h*e-e*h-2*e*H,
          h*f-f*h+2*f*H,
          f*H-H*f,
          e*H-H*e,
          h*H-H*h;
  }
  if (a == "shift1inverse") {
    ring r = 0,(D,x,t),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = D*x-x*D-D,
          t*x-1,
          x*t-1;
  }
  if (a == "exterior2") {
    ring r = 0,(y,x),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = y*x+x*y,
          x*x,
          y*y;
  }
  if (a == "quadrowmm") {
    ring r = 0,(y,x),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = y*x-x*y,
          x*x,
          y*y;
  }
  if (a == "shift1") {
    ring r = 0,(s,x),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = s*x-x*s-s;
  }
  if (a == "weyl1inverse") {
    ring r = 0,(D,x,t),dp;
    def R = makeLetterplaceRing(d);
    setring(R);
    ideal I = D*x-x*D-1,
          t*x-1,
          x*t-1;
  }

  if (!defined(I)) {
    ERROR("Illegal argument for algebra");
  }

  export(I);
  if (baseringdef == 1) {setring save;}
  return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = operatorAlgebra("integrodiff3",5); setring R;
  I; //relations of the algebra
}

////////////////////////////////////////////////////////////////////
// Baumslag ////////////////////////////////////////////////////////
// from Grischa Studzinski /////////////////////////////////////////
////////////////////////////////////////////////////////////////////

proc baumslagSolitar(int n, int m, int d, list #)
"USAGE: baumslagSolitar(m,n,d[,IsGroup]); n an integer, m an integer, d an integer, IsGroup an optional integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - in the group case: A = a^(-1), B = b^(-1)
      - negative input is only allowed in the group case!
      - d gives a degreebound and must be >m,n
      - varying n and m produces a family of examples
"
{
  int isGroup = 0;
  if (size(#) > 0) {isGroup = #[1];}

  if (isGroup != 0)
  {
   int baseringdef;
   if (defined(basering)) // if a basering is defined, it should be saved for later use
   {
    def save = basering;
    baseringdef = 1;
   }
   if (m < 0 || n < 0) {ERROR("Exponent can't be negativ in monoid rings!");}
   if (d < 1 || d < m || d < n) {ERROR("Degree bound must be positiv and greater then m,n!");}
   int i;
   ring mr = 0,(a,b),Dp;
   def Mr = makeLetterplaceRing(d);
   setring Mr;
   poly p,q;
   if (n==0) {p = b;}
   else
   {
    p = a*b;
    for (i = 1; i < n; i++) {p = a*p;}
   }
   if (m==0) {q = b;}
   else
   {
    q = b*a;
    for (i = 1; i < m; i++) {q = q*a;}
   }
   ideal I = p - q;
   export(I);
   if (baseringdef == 1) {setring save;}
   return(Mr);
  }
  else
  {
   int baseringdef;
   if (defined(basering)) // if a basering is defined, it should be saved for later use
   {
    def save = basering;
    baseringdef = 1;
   }
   int i;
   if (d < 1 || d < absValue(m) || d < absValue(n)) {ERROR("Degree bound must be positiv and greater then |m|,|n|!");}
   ring gr = 0,(a,b,A,B),Dp;
   def Gr = makeLetterplaceRing(d);
   setring Gr;
   poly p,q;
   if (n==0) {p = b;}
   else
   {if (n > 0)
    {
     p = a*b;
     for (i = 1; i < n; i++) {p = a*p;}
    }
    else
    {
     p = A*b;
     for (i = 1; i < -n; i++) {p = A*p;}
    }
   }
   if (m==0) {q = b;}
   else
   {if (m > 0)
    {
     q = b*a;
     for (i = 1; i < m; i++) {q = q*a;}
    }
    else
    {
     q = A*b;
     for (i = 1; i < -m; i++) {q = q*A;}
    }
   }
   ideal I = p - q, a*A - 1, b*B - 1, a*A - A*a, b*B - B*b;
   export(I);
   if (baseringdef == 1) {setring save;}
   return(Gr);
  }
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = baumslagSolitar(2,3,4); setring R;
  I;
}

proc baumslagGroup(int m, int n, int d)
"USAGE: baumslagGroup(m,n,d); m an integer, n an integer, d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - Baumslag group with the following presentation
        < a, b | a^m = b^n = 1 >
      -d gives the degreebound for the Letterplace ring
      - varying n and m produces a family of examples
"
{
 if (m < 0 || n < 0 ) {ERROR("m,n must be non-negativ integers!");}
 if (d < 1 || d < m || d < n) {ERROR("degreebound must be positiv and larger than n and m!");}
 int i;
 ring r = 0,(a,b),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 poly p,q;
 p = 1; q = 1;
 for (i = 1; i <= m; i++){p = p*a;}
 for (i = 1; i <= n; i++){q = q*b;}
 ideal I = p-1,q-1;
 export(I);
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = baumslagGroup(2,3,4); setring R;
  I;
}

////////////////////////////////////////////////////////////////////
// Crystallographic Groups //////////////////////////////////////////
// from Grischa Studzinski /////////////////////////////////////////
////////////////////////////////////////////////////////////////////

proc crystallographicGroupP1(int d)
"USAGE: crystallographicGroupP1(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p1 group with the following presentation
        < x, y | [x, y] = 1 >
      -d gives the degreebound for the Letterplace ring
"
{
 if (d < 2){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x,y,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, X*x-1, x*X-1, y*Y-1, Y*y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP1(5); setring R;
  I;
}

// old? there is already another crystallographicGroupP2 proc
/* proc crystallographicGroupP2(int d) */
/* " */
/* p2 group with the following presentation */
/* < x, y, r | [x, y] = r^2 = 1, r^(-1)*x*r = x^(-1), r^(-1)*y*r = y^(-1) > */
/* Note: r = r^(-1) */
/* " */
/* { */
/*  if (d < 3){ERROR("Degreebound is to small for choosen example!");} */

/*  int baseringdef; */
/*  if (defined(basering)) // if a basering is defined, it should be saved for later use */
/*  { */
/*   def save = basering; */
/*   baseringdef = 1; */
/*  } */
/*  ring r = 2,(x,y,r,X,Y),dp; */
/*  def R = makeLetterplaceRing(d); */
/*  setring R; */
/*  ideal I = x*y-y*x-1, x*y-y*x-r*r, r*r-1, r*x*r-X, r*y*r-Y,x*X-1, */
/* X*x-1, Y*y-1,  y*Y-1; */
/*  I = simplify(I,2); */
/*  export(I); */
/*  if (baseringdef == 1) {setring save;} */
/*  return(R); */
/* } */

proc crystallographicGroupPM(int d)
"USAGE: crystallographicGroupPM(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - pm group with the following presentation
        < x, y, m | [x, y] = m^2 = 1, m^(-1)*x*m = x, m^(-1)*y*m = y^(-1) >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 3){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x,y,m,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-m*m, m*m-1, m*x*m-x, m*y*m-Y,x*X-1,
X*x-1, Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupPM(5); setring R;
  I;
}

proc crystallographicGroupPG(int d)
"USAGE: crystallographicGroupPG(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - pg group with the following presentation
        < x, y, t | [x, y] = 1, t^2 = x, t^(-1)*y*t = y^(-1) >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 3){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x,y,t,X,Y,T),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, t*t - x, T*y*t-Y, X*x-1, x*X-1,
Y*y-1,  y*Y-1, t*T-1, T*t-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupPG(5); setring R;
  I;
}


proc crystallographicGroupP2MM(int d)
"USAGE: crystallographicGroupP2MM(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p2mm group with the following presentation
        < x, y, p, q | [x, y] = [p, q] = p^2 = q^2 = 1, p^(-1)*x*p = x, q^(-1)*x*q = x^(-1), p^(-1)*y*p = y^(-1), q^(-1)*y*q = y >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 3){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x,y,p,q,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, p*q-q*p-1, p*p - 1, q*q - 1, p*y*p-Y, p*x*p-x,
 q*y*q-y, q*x*q-X, X*x-1, x*X-1,  Y*y-1,  y*Y-1,  x*y-y*x- p*p,
 x*y-y*x- q*q, p*p-q*q;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP2MM(5); setring R;
  I;
}

proc crystallographicGroupP2(int d)
"USAGE: crystallographicGroupP2(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p2 group with the following presentation
        < x, y, m, t | [x, y] = t^2 = 1, m^2 = y, t^(-1)*x*t = x, m^(-1)*x*m = x^(-1), t^(-1)*y*t = y^(-1), t^(-1)*m*t = m^(-1) >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 3){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x,y,m,t,X,Y,M),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-t*t, m*m-y, t*t - 1, t*x*t-x,
M*x*m-X, t*y*t-Y, t*m*t-M, X*x-1, x*X-1,  Y*y-1,  y*Y-1,
m*M-1, M*m-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP2(5); setring R;
  I;
}

proc crystallographicGroupP2GG(int d)
"USAGE: crystallographicGroupP2GG(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p2gg group with the following presentation
        < x, y, u, v | [x, y] = (u*v)^2 = 1, u^2 = x, v^2 = y, v^(-1)*x*v = x^(-1), u^(-1)*y*u = y^(-1) >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 4){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x,y,u,v,X,Y,U,V),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-u*v*u*v, u*v*u*v-1, u*u-x, v*v - y,
V*x*v-X, U*y*u-Y,
X*x-1, x*X-1,  Y*y-1,  y*Y-1, u*U-1, U*u-1, v*V-1, V*v-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP2GG(5); setring R;
  I;
}

proc crystallographicGroupCM(int d)
"USAGE: crystallographicGroupCM(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - cm group with the following presentation
        < x, y, t | [x, y] = t^2 = 1, t^(-1)*x*t = x*y, t^(-1)*y*t = y^(-1) >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 3){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x,y,t,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-t*t, t*t-1,
t*x*t-x*y, t*y*t-Y,
X*x-1, x*X-1,  Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupCM(5); setring R;
  I;
}

proc crystallographicGroupC2MM(int d)
"USAGE: crystallographicGroupC2MM(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - c2mm group with the following presentation
        < x, y, m, r | [x, y] = m^2 = r^2 = 1, m^(-1)*y*m = y^(-1), m^(-1)*x*m = x*y, r^(-1)*y*r = y^(-1), r^(-1)*x*r = x^(-1), m^(-1)*r*m = r^(-1) >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 3){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,m,r,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-m*m, x*y-y*x-r*r, m*m-1,  r*r-1,
 m*m-r*r, m*y*m-Y, m*x*m-x*y, r*y*r-Y, r*x*r-X, m*r*m-r,
X*x-1, x*X-1,  Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupC2MM(5); setring R;
  I;
}

proc crystallographicGroupP4(int d)
"USAGE: crystallographicGroupP4(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p4 group with the following presentation
        < x, y, r | [x, y] = r^4 = 1, r^(-1)*x*r = x^(-1), r^(-1)*x*r = y >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 5){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,r,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-r*r*r*r, r*r*r*r-1,
 r*r*r*x*r-X, r*r*r*x*r-y,
X*x-1, x*X-1,  Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP4(5); setring R;
  I;
}

proc crystallographicGroupP4MM(int d)
"USAGE: crystallographicGroupP4MM(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p4mm group with the following presentation
        < x, y, r, m | [x, y] = r^4 = m^2 = 1, r^(-1)*y*r = x^(-1), r^(-1)*x*r = y, m^(-1)*x*m = y, m^(-1)*r*m = r^(-1) >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 5){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,r,m,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-r*r*r*r,  r*r*r*r-1,
 r*r*r*x*r-X, r*r*r*x*r-y,
X*x-1, x*X-1,  Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP4MM(5); setring R;
  I;
}

proc crystallographicGroupP4GM(int d)
"USAGE: crystallographicGroupP4GM(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p4gm group with the following presentation
        < x, y, r, t | [x, y] = r^4 = t^2 = 1, r^(-1)*y*r = x^(-1), r^(-1)*x*r = y, t^(-1)*x*t = y, t^(-1)*r*t = x^(-1)*r^(-1)>
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 5){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,r,t,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-r*r*r*r,  r*r*r*r-1, x*y-y*x-t*t,
 t*t-1,  r*r*r*r-t*t,  r*r*r*y*r-X, r*r*r*x*r-y,
 t*r*t-X*r*r*r, X*x-1, x*X-1,  Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP4GM(5); setring R;
  I;
}

proc crystallographicGroupP3(int d)
"USAGE: crystallographicGroupP3(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p3 group with the following presentation
        < x, y, r | [x, y] = r^3 = 1, r^(-1)*x*r = x^(-1)*y, r^(-1)*y*r = x^(-1)>
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 4){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,r,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-r*r*r,  r*r*r-1,
  r*r*x*r-X*y,  r*r*y*r-X, X*x-1, x*X-1,  Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP3(5); setring R;
  I;
}

proc crystallographicGroupP31M(int d)
"USAGE: crystallographicGroupP31M(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p31m group with the following presentation
        < x, y, r, t | [x, y] = r^2 = t^2 = (t*r)^3 = 1, r^(-1)*x*r = x, t^(-1)*y*t = y, t^(-1)*x*t = x^(-1)*y, r^(-1)*y*r = x*y^(-1) >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 6){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,r,t,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-r*r, x*y-y*x-t*t, r*r-1, t*t-1,
 t*r*t*r*t*r-1, r*r-t*t,  x*y-y*x-t*r*t*r*t*r,
 t*r*t*r*t*r-r*r, t*r*t*r*t*r-t*t,
 r*x*r-x,  t*y*t-y, t*x*t-X*y, r*y*r-x*Y,
 X*x-1, x*X-1, Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP31M(6); setring R;
  I;
}

proc crystallographicGroupP3M1(int d)
"USAGE: crystallographicGroupP3M1(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p3m1 group with the following presentation
        < x, y, r, m | [x, y] = r^3 = m^2 = 1, m^(-1)*r*m = r^2, r^(-1)*x*r = x^(-1)*y, r^(-1)*y*r = x^(-1), m^(-1)*x*m = x^(-1), m^(-1)*y*m = x^(-1)*y >
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 4){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,r,m,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-r*r*r, x*y-y*x-m*m, r*r*r-1, m*m-1,
 r*r*r-m*m,  m*r*m-r*r, r*r*x*r-X*y, r*r*y*r-X,m*x*m-X,
 m*y*m-X*y, X*x-1, x*X-1, Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP3M1(5); setring R;
  I;
}

proc crystallographicGroupP6(int d)
"USAGE: crystallographicGroupP6(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p6 group with the following presentation
        < x, y, r | [x, y] = r^6 = 1, r^(-1)*x*r = y, r^(-1)*y*r = x^(-1)*y>
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 7){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,r,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-r*r*r*r*r*r, r*r*r*r*r*r-1,
 r*r*r*r*r*x*r-y, r*r*r*r*r*y*r-X*y,
 X*x-1, x*X-1, Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP6(7); setring R;
  I;
}

proc crystallographicGroupP6MM(int d)
"USAGE: crystallographicGroupP6MM(d); d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - p6mm group with the following presentation
        < x, y, r, m | [x, y] = r^6 = m^2 = 1, r^(-1)*y*r = x^(-1)*y, r^(-1)*x*r = y, m^(-1)*x*m = x^(-1), m^(-1)*y*m = x^(-1)*y, m^(-1)*r*m = r^(-1)*y>
      - d gives the degreebound for the Letterplace ring
"
{
 if (d < 7){ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring rr = 2,(x,y,r,m,X,Y),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I = x*y-y*x-1, x*y-y*x-r*r*r*r*r*r, r*r*r*r*r*r-1,
 x*y-y*x-m*m, r*r*r*r*r*r-m*m, m*m-1, m*x*m-X,  m*y*m-X*y,
 r*r*r*r*r*x*r-y, r*r*r*r*r*y*r-X*y, m*r*m- r*r*r*r*r*y,
 X*x-1, x*X-1, Y*y-1,  y*Y-1;
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = crystallographicGroupP6MM(7); setring R;
  I;
}

////////////////////////////////////////////////////////////////////
// Dyck Group //////////////////////////////////////////////////////
// from Grischa Studzinski /////////////////////////////////////////
////////////////////////////////////////////////////////////////////

proc dyckGroup1(int n, int d, intvec P)
"USAGE: dyckGroup1(n,d,P); n an integer, d an integer, P an intvec
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - The Dyck group with the following presentation
        < x_1, x_2, ... , x_n | (x_1)^p1 = (x_2)^p2 = ... = (x_n)^pn = x_1 * x_2 * ... * x_n = 1 >
      - negative exponents are allowed
      - representation in the form x_i^p_i - x_(i+1)^p_(i+1)
      - d gives the degreebound for the Letterplace ring
      - varying n and P produces a family of examples
"
{
 int baseringdef,i,j;
 if (n < 1) {ERROR("There must be at least one variable!");}
 if (d < n) {ERROR("Degreebound is to small!");}
 for (i = 1; i <= size(P); i++) {if (d < absValue(P[i])){ERROR("Degreebound is to small!");}}

 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x(1..n),Y(1..n)),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I; poly p,q;
 p = 1; q = 1;
 for (i = 1; i<= n; i++) {p = p*var(i);}
 I = p-1;
 for (i = n; i > 0; i--)
 {
  if (P[i] >= 0) {for (j = 1; j <= P[i]; j++){q = q*var(i);}}
  else {for (j = 1; j <= -P[i]; j++){q = q*var(i+n);}}
  I = p - q,I;
  p = q; q = 1;
 }

 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec P = 1,2,3;
  def R = dyckGroup1(3,5,P); setring R;
  I;
}


proc dyckGroup2(int n, int d, intvec P)
"USAGE: dyckGroup2(n,d,P); n an integer, d an integer, P an intvec
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - The Dyck group with the following presentation
        < x_1, x_2, ... , x_n | (x_1)^p1 = (x_2)^p2 = ... = (x_n)^pn = x_1 * x_2 * ... * x_n = 1 >
      - negative exponents are allowed
      - representation in the form x_i^p_i - 1
      - d gives the degreebound for the Letterplace ring
      - varying n and P produces a family of examples
"
{
 int baseringdef,i,j;
 if (n < 1) {ERROR("There must be at least one variable!");}
 if (d < n) {ERROR("Degreebound is to small!");}
 for (i = 1; i <= size(P); i++) {if (d < absValue(P[i])){ERROR("Degreebound is to small!");}}

 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x(1..n),Y(1..n)),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I; poly p;
 p = 1;
 for (i = 1; i<= n; i++) {p = p*var(i);}
 I = p-1;
 for (i = n; i > 0; i--)
 {
  p = 1;
  if (P[i] >= 0) {for (j = 1; j <= P[i]; j++){p = p*var(i);}}
  else {for (j = 1; j <= -P[i]; j++){p = p*var(i+n);}}
  I = p - 1,I;
 }

 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec P = 1,2,3;
  def R = dyckGroup2(3,5,P); setring R;
  I;
}



proc dyckGroup3(int n, int d, intvec P)
"USAGE: dyckGroup2(n,d,P); n an integer, d an integer, P an intvec
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - The Dyck group with the following presentation
        < x_1, x_2, ... , x_n | (x_1)^p1 = (x_2)^p2 = ... = (x_n)^pn = x_1 * x_2 * ... * x_n = 1 >
      - only positive exponents are allowed
      - no inverse generators needed
      - d gives the degreebound for the Letterplace ring
      - varying n and P produces a family of examples
"
{
 int baseringdef,i,j;
 if (n < 1) {ERROR("There must be at least one variable!");}
 if (d < n) {ERROR("Degreebound is to small!");}
 for (i = 1; i <= size(P); i++) {if (P[i] < 0){ERROR("Exponents must be positive!");}}
 for (i = 1; i <= size(P); i++) {if (d < P[i]){ERROR("Degreebound is to small!");}}


 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,x(1..n),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I; poly p;
 p = 1;
 for (i = 1; i<= n; i++) {p = p*var(i);}
 I = p-1;
 for (i = n; i > 0; i--)
 {
  p = 1;
  for (j = 1; j <= P[i]; j++){p = p*var(i);}
  I = p - 1,I;
 }

 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec P = 1,2,3;
  def R = dyckGroup3(3,5,P); setring R;
  I;
}

////////////////////////////////////////////////////////////////////
// Fibonacci Group /////////////////////////////////////////////////
// from Grischa Studzinski /////////////////////////////////////////
////////////////////////////////////////////////////////////////////

proc fibonacciGroup(int m, int d)
"USAGE: fibonacciGroup(m,d); m an integer, d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - The Fibonacci group F(2, m) with the following presentation
        < x_1, x_2, ... , x_m | x_i * x_(i + 1) = x_(i + 2) >
      - d gives the degreebound for the Letterplace ring
      - varying m produces a family of examples
"
{
// TODO: basefield Q oder F2?
// TODO: inverse Elemente!
 if (m < 3) {ERROR("At least three generators are required!");}
 if (d < 2) {ERROR("Degree bound must be at least 2!");}
 int baseringdef,i;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x(1..m),Y(1..m)),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I; poly p;
 for (i = 1; i < m-1; i++)
 {
  p = var(i)*var(i+1)-var(i+2);
  I = I,p;
 }
 for (i = 1; i <= m; i++)
 {
  p = var(i)*var(i+m)-1;
  I = I,p;
  p = var(i+m)*var(i)-1;
  I = I,p;
 }
 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = fibonacciGroup(3,5); setring R;
  I;
}


////////////////////////////////////////////////////////////////////
// Tetrahedron Groups ///////////////////////////////////////////////
// from Grischa Studzinski /////////////////////////////////////////
////////////////////////////////////////////////////////////////////

proc tetrahedronGroup(int g, int d)
"USAGE: tetrahedronGroup(g,d); g an integer, d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - g gives the number of the example (1 - 5)
      - d gives the degreebound for the Letterplace ring
      - varying g produces a family of examples

The examples are found in ``Classification of the finite generalized tetrahedron groups''
by Gerhard Rosenberger and Martin Scheer.
The 5 examples originate from Proposition 1.9 and describe
finite generalized tetrahedron group in the Tsaranov-case, which are
not equivalent to a presentation for an ordinary tetrahedron group.
"
{
 if (g < 1 || g > 5) {ERROR("There are only 5 examples!");}
 if ((g == 1 && d < 6)||(g == 2 && d < 6)||(g == 3 && d < 5)||(g == 4 && d < 4)||(g == 5 && d < 5))
 {ERROR("Degreebound is to small for choosen example!");}

 int baseringdef,i,j;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(x,y,z),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I;
 if (g == 1)
 {I = x*x*x*x*x-1, y*y-1, z*z*z-1, x*y*x*y*x*y-1, x*x*z*x*x*z-1,
      y*z*y*z-1;
 }
 if (g == 2)
 {I = x*x*x-1, y*y*y-1, z*z*z*z*z-1,x*y*x*y-1,x*z*x*z-1,
      y*z*z*y*z*z-1;
 }
 if (g == 3)
 {I =  x*x*x-1, y*y*y-1, z*z*z-1, x*y*x*y-1, x*z*x*z-1, y*z*y*z-1;
 }
 if (g == 4)
 {I =  x*x*x-1, y*y*y-1, z*z*z*z-1,x*y*x*y-1, x*z*x*z-1, y*z*y*z-1;
 }
 if (g ==5)
 {I =  x*x*x-1, y*y*y-1, z*z*z*z*z-1,x*y*x*y-1, x*z*x*z-1, y*z*y*z-1;
 }

 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = tetrahedronGroup(3,5); setring R;
  I;
}


////////////////////////////////////////////////////////////////////
// Triangular Groups ///////////////////////////////////////////////
// from Grischa Studzinski /////////////////////////////////////////
////////////////////////////////////////////////////////////////////

proc triangularGroup(int g, int d)
"USAGE: triangularGroup(g,d); g an integer, d an integer
RETURN: ring
NOTE: - the ring contains the ideal I, which contains the required relations
      - g gives the number of the example (1 - 14)
      - d gives the degreebound for the Letterplace ring
      - varying g produces a family of examples

The examples are found in
Classification of the finite generalized tetrahedron groups
by Gerhard Rosenberger and Martin Scheer.
The 14 examples are denoted in theorem 2.12
"
{
 if (g < 1 || g > 14) {ERROR("There are only 14 examples!");}
 if ((g == 1 && d < 20)||(g == 2 && d < 21)||(g == 3 && d < 10)||(g == 4 && d < 12)||(g == 5 && d < 10)||(g == 6 && d < 18)||(g == 7 && d < 20)||(g == 8 && d < 16)||(g == 9 && d < 10)||(g == 10 && d < 14)||(g == 11 && d < 16)||(g == 12 && d < 24)||(g == 13 && d < 28)||(g == 14 && d < 37))
 {ERROR("Degreebound is to small for choosen example!");}

 int baseringdef;
 if (defined(basering)) // if a basering is defined, it should be saved for later use
 {
  def save = basering;
  baseringdef = 1;
 }
 ring r = 2,(a,b),dp;
 def R = makeLetterplaceRing(d);
 setring R;
 ideal I;

 if (g == 1)
 {I = a*a-1, b*b*b-1,
  a*b*a*b*a*b*b*a*b*b*a*b*a*b*a*b*b*a*b*b-1;
 }
 if (g == 2)
 {I = a*a-1, b*b*b-1,
  a*b*a*b*a*b*b*a*b*a*b*a*b*b*a*b*a*b*a*b*b-1;
 }
 if (g == 3)
 {I = a*a*a-1, b*b*b-1,
  a*b*a*b*b*a*b*a*b*b-1;
 }
 if (g == 4)
 {I = a*a*a-1, b*b*b-1,
  a*b*a*a*b*b*a*b*a*a*b*b-1;
 }
 if (g == 5)
 {I = a*a-1, b*b*b*b*b-1,
   a*b*a*b*b*a*b*a*b*b-1;
 }
 if (g == 6)
 {I = a*a-1, b*b*b*b*b-1,
   a*b*a*b*a*b*b*b*b*a*b*a*b*a*b*b*b*b-1;
 }
 if (g == 7)
 {I = a*a-1, b*b*b*b*b-1,
   a*b*a*b*b*a*b*b*b*b*a*b*a*b*b*a*b*b*b*b-1;
 }
 if (g == 8)
 {I = a*a-1, b*b*b*b-1,
   a*b*a*b*a*b*b*b*a*b*a*b*a*b*b*b-1;
 }
 if (g == 9)
 {I = a*a-1, b*b*b-1,
   a*b*a*b*b*a*b*a*b*b-1;
 }
 if (g == 10)
 {I = a*a-1, b*b*b-1,
  a*b*a*b*a*b*b*a*b*a*b*a*b*b-1;
 }
 if (g == 11)
 {I = a*a-1, b*b*b-1,
  a*b*a*b*a*b*a*b*b*a*b*a*b*a*b*b-1;
 }
 if (g == 12)
 {I = a*a-1, b*b*b-1,
  a*b*a*b*a*b*b*a*b*a*b*b*a*b*a*b*a*b*b*a*b*a*b*b-1;
 }
 if (g == 13)
 {I = a*a-1, b*b*b-1,
a*b*a*b*a*b*a*b*a*b*b*a*b*b*a*b*a*b*a*b*a*b*a*b*b*a*b*b-1;
 }
 if (g == 14)
 {I = a*a-1, b*b*b-1,
a*b*a*b*a*b*a*b*b*a*b*b*a*b*a*b*b*a*b*b*a*b*a*b*a*b*a*b*b*a*b*a*b*b*a*b*b-1;
 }

 I = simplify(I,2);
 export(I);
 if (baseringdef == 1) {setring save;}
 return(R);
}
example
{
  "EXAMPLE:"; echo = 2;
  def R = triangularGroup(3,10); setring R;
  I;
}