source: git/Singular/LIB/involut.lib @ 1fdee9

spielwiese
Last change on this file since 1fdee9 was 1fdee9, checked in by Viktor Levandovskyy <levandov@…>, 19 years ago
*levandov: suggestions by GMG implemented, additions, some procs moved to general Singular libs, rearranged and corrected git-svn-id: file:///usr/local/Singular/svn/trunk@8233 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 21.3 KB
Line 
1version="$Id: involut.lib,v 1.6 2005-05-18 18:09:11 levandov Exp $";
2category="Noncommutative";
3info="
4LIBRARY:  involution.lib  Procedures for Computations and Operations with Involutions
5AUTHORS:  Oleksandr Iena,       yena@mathematik.uni-kl.de,
6@*        Markus Becker,        mbecker@mathematik.uni-kl.de,
7@*        Viktor Levandovskyy,  levandov@mathematik.uni-kl.de
8
9THEORY: Involution is an antiisomorphism of a noncommutative algebra with the
10 property that applied an involution twice, one gets an identity. Involution is linear with respect to the ground field. In this library we compute linear involutions, distinguishing the case of a diagonal matrix (such involutions are called homothetic) and a general one.
11
12SUPPORT: Forschungsschwerpunkt 'Mathematik und Praxis' (Project of Dr. E. Zerz
13and V. Levandovskyy), Uni Kaiserslautern
14
15NOTE: This library provides algebraic tools for computations and operations
16with algebraic involutions and linear automorphisms of noncommutative algebras
17
18PROCEDURES:
19findInvo();          computes linear involutions on a basering;
20findInvoDiag();     computes homothetic (diagonal) involutions on a basering;
21findAuto();          computes linear automorphisms of a basering;
22ncdetection();        computes an ideal, presenting an involution map on some particular noncommutative algebras;
23involution(m,theta);  applies the involution to an object.
24";
25
26LIB "ncalg.lib";
27LIB "poly.lib";
28LIB "primdec.lib";
29///////////////////////////////////////////////////////////////////////////////
30proc ncdetection()
31"USAGE:  ncdetection();
32RETURN:  ideal, representing an involution map
33PURPOSE: compute classical involutions (i.e. acting rather on operators than on variables) for some particular noncommutative algebras
34ASSUME: the procedure is aimed at noncommutative algebras with differential, shift or advance operators arising in Control Theory. It has to be executed in the ring.
35EXAMPLE: example ncdetection; shows an example
36"{
37// in this procedure an involution map is generated from the NCRelations
38// that will be used in the function involution
39// in dieser proc. wird eine matrix erzeugt, die in der i-ten zeile die indices
40// der differential-, shift- oder advance-operatoren enthaelt mit denen die i-te
41// variable nicht kommutiert.
42  if ( nameof(basering)=="basering" )
43  {
44    "No current ring defined.";
45    return(ideal(0));
46  }
47  def r = basering;
48  setring r;
49  int i,j,k,LExp;
50  int NVars  = nvars(r);
51  matrix rel = ncRelations(r)[2];
52  intmat M[NVars][3];
53  int NRows = nrows(rel);
54  intvec v,w;
55  poly d,d_lead;
56  ideal I;
57  map theta;
58  for( j=NRows; j>=2; j-- )
59  {
60   if( rel[j] == w )       //the whole column is zero
61    {
62      j--;
63      continue;
64    }
65    for( i=1; i<j; i++ )
66    {
67      if( rel[i,j]==1 )        //relation of type var(j)*var(i) = var(i)*var(j) +1
68      {
69         M[i,1]=j;
70      }
71      if( rel[i,j] == -1 )    //relation of type var(i)*var(j) = var(j)*var(i) -1
72      {
73        M[j,1]=i;
74      }
75      d = rel[i,j];
76      d_lead = lead(d);
77      v = leadexp(d_lead); //in the next lines we check wether we have a  relation of differential or shift type
78      LExp=0;
79      for(k=1; k<=NVars; k++)
80      {
81        LExp = LExp + v[k];
82      }
83      //      if( (d-d_lead != 0) || (LExp > 1) )
84if ( ( (d-d_lead) != 0) || (LExp > 1) || ( (LExp==0) && ((d_lead>1) || (d_lead<-1)) ) )
85      {
86        return(theta);
87      }
88
89      if( v[j] == 1)                   //relation of type var(j)*var(i) = var(i)*var(j) -lambda*var(j)
90      {
91        if (leadcoef(d) < 0)
92        {
93          M[i,2] = j;
94        }
95        else
96        {
97          M[i,3] = j;
98        }
99      }
100      if( v[i]==1 )                    //relation of type var(j)*var(i) = var(i)*var(j) -lambda*var(i)
101      {
102        if (leadcoef(d) > 0)
103        {
104          M[j,2] = i;
105        }
106        else
107        {
108          M[j,3] = i;
109        }
110      }
111    }
112  }
113  // from here on, the map is computed
114  for(i=1;i<=NVars;i++)
115  {
116    I=I+var(i);
117  }
118
119  for(i=1;i<=NVars;i++)
120  {
121    if( M[i,1..3]==(0,0,0) )
122    {
123      i++;
124      continue;
125    }
126    if( M[i,1]!=0 )
127    {
128      if( (M[i,2]!=0) && (M[i,3]!=0) )
129      {
130        I[M[i,1]] = -var(M[i,1]);
131        I[M[i,2]] = var(M[i,3]);
132        I[M[i,3]] = var(M[i,2]);
133      }
134      if( (M[i,2]==0) && (M[i,3]==0) )
135      {
136        I[M[i,1]] = -var(M[i,1]);
137      }
138      if( ( (M[i,2]!=0) && (M[i,3]==0) )|| ( (M[i,2]!=0) && (M[i,3]==0) )
139)
140      {
141        I[i] = -var(i);
142      }
143    }
144    else
145    {
146      if( (M[i,2]!=0) && (M[i,3]!=0) )
147      {
148        I[i] = -var(i);
149        I[M[i,2]] = var(M[i,3]);
150        I[M[i,3]] = var(M[i,2]);
151      }
152      else
153      {
154        I[i] = -var(i);
155      }
156    }
157  }
158  return(I);
159}
160example
161{
162  "EXAMPLE:"; echo = 2;
163  ring r=0,(x,y,z,D(1..3)),dp;
164  matrix D[6][6];
165  D[1,4]=1; D[2,5]=1;  D[3,6]=1;
166  ncalgebra(1,D);
167  ncdetection();
168  kill r;
169  //----------------------------------------
170  ring r=0,(x,S),dp;
171  ncalgebra(1,-S);
172  ncdetection();
173  kill r;
174  //----------------------------------------
175  ring r=0,(x,D(1),S),dp;
176  matrix D[3][3];
177  D[1,2]=1;  D[1,3]=-S;
178  ncalgebra(1,D);
179  ncdetection();
180}
181
182static proc In_Poly(poly mm, list l, int NVars)
183// applies the involution to the poly mm
184// entries of a list l are images of variables under invo
185// more general than invo_poly; used in many rings setting
186{
187  int i,j;
188  intvec v;
189  poly pp, zz;
190  poly nn = 0;
191  i = 1;
192  while(mm[i]!=0)
193  {
194    v  = leadexp(mm[i]);
195    zz = 1;
196    for( j=NVars; j>=1; j--)
197    {
198      if (v[j]!=0)
199      {
200        pp = l[j];
201        zz = zz*(pp^v[j]);
202      }
203    }
204    nn = nn + (leadcoef(mm[i])*zz);
205    i++;
206  }
207  return(nn);
208}
209
210static proc Hom_Poly(poly mm, list l, int NVars)
211// applies the endomorphism to the poly mm
212// entries of a list l are images of variables under endo
213// should not be replaced by map-based stuff! used in
214// many rings setting
215{
216  int i,j;
217  intvec v;
218  poly pp, zz;
219  poly nn = 0;
220  i = 1;
221  while(mm[i]!=0)
222  {
223    v  = leadexp(mm[i]);
224    zz = 1;
225    for( j=NVars; j>=1; j--)
226    {
227      if (v[j]!=0)
228      {
229        pp = l[j];
230        zz = (pp^v[j])*zz;
231      }
232    }
233    nn = nn + (leadcoef(mm[i])*zz);
234    i++;
235  }
236  return(nn);
237}
238
239static proc invo_poly(poly m, map theta)
240// applies the involution map theta to m, where m=polynomial
241{
242  // compatibility:
243  ideal l = ideal(theta);
244  int i;
245  list L;
246  for (i=1; i<=size(l); i++)
247  {
248    L[i] = l[i];
249  }
250  int nv = nvars(basering);
251  return (In_Poly(m,L,nv));
252//   if (m==0) { return(m); }
253//   int i,j;
254//   intvec v;
255//   poly p,z;
256//   poly n = 0;
257//   i = 1;
258//   while(m[i]!=0)
259//   {
260//     v = leadexp(m[i]);
261//     z =1;
262//     for(j=nvars(basering); j>=1; j--)
263//     {
264//       if (v[j]!=0)
265//       {
266//         p = var(j);
267//         p = theta(p);
268//         z = z*(p^v[j]);
269//       }
270//     }
271//     n = n + (leadcoef(m[i])*z);
272//     i++;
273//   }
274//   return(n);
275}
276///////////////////////////////////////////////////////////////////////////////////
277proc involution(m, map theta)
278"USAGE:  involution(m, theta); m is a poly/vector/ideal/matrix/module, theta is a map
279RETURN:  object of the same type as m
280PURPOSE: applies the involution, presented by theta to the object m
281THEORY: for an involution theta and two polynomials a,b from the algebra, theta(ab) = theta(b) theta(a); theta is linear with respect to the ground field
282EXAMPLE: example involution; shows an example
283"{
284  // applies the involution map theta to m,
285  // where m= vector, polynomial, module, matrix, ideal
286  int i,j;
287  intvec v;
288  poly p,z;
289  if (typeof(m)=="poly")
290  {
291    return (invo_poly(m,theta));
292  }
293  if ( typeof(m)=="ideal" )
294  {
295    ideal n;
296    for (i=1; i<=size(m); i++)
297    {
298      n[i] = invo_poly(m[i], theta);
299    }
300    return(n);
301  }
302  if (typeof(m)=="vector")
303  {
304    for(i=1; i<=size(m); i++)
305    {
306      m[i] = invo_poly(m[i], theta);
307    }
308    return (m);
309  }
310  if ( (typeof(m)=="matrix") || (typeof(m)=="module"))
311  {
312    matrix n = matrix(m);
313    int @R=nrows(n);
314    int @C=ncols(n);
315    for(i=1; i<=@R; i++)
316    {
317      for(j=1; j<=@C; j++)
318      {
319        if (m[i,j]!=0)
320        {
321          n[i,j] = invo_poly( m[i,j], theta);
322        }
323      }
324    }
325    if (typeof(m)=="module")
326    {
327      return (module(n));
328    }
329    else // matrix
330    {
331      return(n);
332    }
333  }
334  // if m is not of the supported type:
335  "Error: unsupported argument type!";
336  return();
337}
338example
339{
340  "EXAMPLE:";echo = 2;
341  ring r = 0,(x,d),dp;
342  ncalgebra(1,1); // Weyl-Algebra
343  map F = r,x,-d;
344  poly f =  x*d^2+d;
345  poly If = involution(f,F);
346  f-If;
347  poly g = x^2*d+2*x*d+3*x+7*d;
348  poly tg = -d*x^2-2*d*x+3*x-7*d;
349  poly Ig = involution(g,F);
350  tg-Ig;
351  ideal I = f,g;
352  ideal II = involution(I,F);
353  II;
354  I - involution(II,F);
355  module M  = [f,g,0],[g,0,x^2*d];
356  module IM = involution(M,F);
357  print(IM);
358  print(M - involution(IM,F));
359}
360///////////////////////////////////////////////////////////////////////////////////
361static proc new_var()
362//generates a string of new variables
363{
364
365  int NVars=nvars(basering);
366  int i,j;
367  //  string s="@_1_1";
368  string s="a11";
369  for(i=1; i<=NVars; i++)
370  {
371    for(j=1; j<=NVars; j++)
372    {
373      if(i*j!=1)
374      {
375        s = s+ ","+NVAR(i,j);
376      };
377    };
378  };
379  return(s);
380};
381
382static proc NVAR(int i, int j)
383{
384  //  return("@_"+string(i)+"_"+string(j));
385  return("a"+string(i)+string(j));
386};
387///////////////////////////////////////////////////////////////////////////////////
388static proc new_var_special()
389//generates a string of new variables
390{
391  int NVars=nvars(basering);
392  int i;
393  //  string s="@_1_1";
394  string s="a11";
395  for(i=2; i<=NVars; i++)
396  {
397    s = s+ ","+NVAR(i,i);
398  };
399  return(s);
400};
401///////////////////////////////////////////////////////////////////////////////////
402static proc RelMatr()
403// returns the matrix of relations
404// only Lie-type relations x_j x_i= x_i x_j + .. are taken into account
405{
406  int i,j;
407  int NVars = nvars(basering);
408  matrix Rel[NVars][NVars];
409  for(i=1; i<NVars; i++)
410  {
411    for(j=i+1; j<=NVars; j++)
412    {
413      Rel[i,j]=var(j)*var(i)-var(i)*var(j);
414    };
415  };
416  return(Rel);
417};
418/////////////////////////////////////////////////////////////////
419proc findInvo()
420"USAGE: findInvo();
421RETURN: a ring containing a list L of pairs, where
422@*        L[i][1]  =  Groebner Basis of an i-th associated prime,
423@*        L[i][2]  =  matrix, defining a linear map, with entries, reduced with respect to L[i][1]
424PURPOSE: computed the ideal of linear involutions of the basering
425NOTE: for convenience, the full ideal of relations @code{idJ}
426and the initial matrix with indeterminates @code{matD} are exported in the output ring
427SEE ALSO: findInvoDiag, involution
428EXAMPLE: example findInvo; shows examples
429
430"{
431  def @B    = basering; //save the name of basering
432  int NVars = nvars(@B); //number of variables in basering
433  int i, j;
434
435  matrix Rel = RelMatr(); //the matrix of relations
436
437  string s   = new_var(); //string of new variables
438  string Par = parstr(@B); //string of parameters in old ring
439
440  if (Par=="") // if there are no parameters
441  {
442    execute("ring @@K=0,("+varstr(@B)+","+s+"), dp;"); //new ring with new variables
443  }
444  else //if there exist parameters
445  {
446     execute("ring @@K=(0,"+Par+") ,("+varstr(@B)+","+s+"), dp;");//new ring with new variables
447  };
448
449  matrix Rel = imap(@B, Rel); //consider the matrix of relations in new ring
450
451  int Sz = NVars*NVars+NVars; // number of variables in new ring
452
453  matrix M[Sz][Sz]; //to be the matrix of relations in new ring
454
455  for(i=1; i<NVars; i++) //initialize that matrix of relations
456  {
457    for(j=i+1; j<=NVars; j++)
458    {
459      M[i,j] = Rel[i,j];
460    };
461  };
462
463  ncalgebra(1, M); //now new ring @@K become a noncommutative ring
464
465  list l; //list to define an involution
466  poly @@F;
467  for(i=1; i<=NVars; i++) //initializing list for involution
468  {
469    @@F=0;
470    for(j=1; j<=NVars; j++)
471    {
472      execute( "@@F = @@F+"+NVAR(i,j)+"*"+string( var(j) )+";" );
473    };
474    l=l+list(@@F);
475  };
476
477  matrix N = Rel; //imap(@B,Rel);
478
479  for(i=1; i<NVars; i++)//get matrix by applying the involution to relations
480  {
481    for(j=i+1; j<=NVars; j++)
482    {
483      N[i,j]= l[j]*l[i] - l[i]*l[j] + In_Poly( N[i,j], l, NVars);
484    };
485  };
486  kill l;
487  //---------------------------------------------
488  //get the ideal of coefficients of N
489  ideal J;
490  ideal idN = simplify(ideal(N),2);
491  J = ideal(coeffs( idN, var(1) ) );
492  for(i=2; i<=NVars; i++)
493  {
494    J = ideal( coeffs( J, var(i) ) );
495  };
496  J = simplify(J,2);
497  //-------------------------------------------------
498  if ( Par=="" ) //initializes the ring of relations
499  {
500    execute("ring @@KK=0,("+s+"), dp;");
501  }
502  else
503  {
504    execute("ring @@KK=(0,"+Par+"),("+s+"), dp;");
505  };
506  ideal J = imap(@@K,J); // ideal, considered in @@KK now
507  string snv = "["+string(NVars)+"]";
508  execute("matrix @@D"+snv+snv+"="+s+";"); // matrix with entries=new variables
509
510  J = J, ideal( @@D*@@D-matrix( freemodule(NVars) ) ); // add the condition that involution to square is just identity
511  J = simplify(J,2); // without extra zeros
512  list mL = minAssGTZ(J); // components not in GB
513  int sL  = size(mL);
514  option(redSB);       // important for reduced GBs
515  option(redTail);
516  matrix IM = @@D;     // involution map
517  list L    = list();  // the answer
518  list TL;
519  ideal tmp = 0;
520  for (i=1; i<=sL; i++) // compute GBs of components
521  {
522    TL    = list();
523    TL[1] = std(mL[i]);
524    tmp   = NF( ideal(IM), TL[1] );
525    TL[2] = matrix(tmp, NVars,NVars);
526    L[i]  = TL;
527  }
528  export(L); // main export
529  ideal idJ = J; // debug-comfortable exports
530  matrix matD = @@D;
531  export(idJ);
532  export(matD);
533  return(@@KK);
534}
535example
536{ "EXAMPLE:"; echo = 2;
537 def a = makeWeyl(1);
538 setring a; // this algebra is a first Weyl algebra
539 def X = findInvo();
540 setring X; // ring with new variables, corr. to unknown coefficients
541 L;
542 // look at the matrix in the new variables, defining the linear involution
543 print(L[1][2]);
544 L[1][1];  // where new variables obey these relations
545}
546///////////////////////////////////////////////////////////////////////////
547proc findInvoDiag()
548"USAGE: findInvoDiag();
549RETURN: a ring together with a list of pairs L, where
550@*        L[i][1]  =  Groebner Basis of an i-th associated prime,
551@*        L[i][2]  =  matrix, defining a linear map, with entries, reduced with respect to L[i][1]
552PURPOSE: compute the ideal of homothetic (diagonal) involutions of the basering
553NOTE: for convenience, the full ideal of relations @code{idJ}
554and the initial matrix with indeterminates @code{matD} are exported in the output ring
555SEE ALSO: findInvo, involution
556EXAMPLE: example findInvoDiag; shows examples
557"{
558  def @B    = basering; //save the name of basering
559  int NVars = nvars(@B); //number of variables in basering
560  int i, j;
561
562  matrix Rel = RelMatr(); //the matrix of relations
563
564  string s   = new_var_special(); //string of new variables
565  string Par = parstr(@B); //string of parameters in old ring
566
567  if (Par=="") // if there are no parameters
568  {
569    execute("ring @@K=0,("+varstr(@B)+","+s+"), dp;"); //new ring with new variables
570  }
571  else //if there exist parameters
572  {
573    execute("ring @@K=(0,"+Par+") ,("+varstr(@B)+","+s+"), dp;");//new ring with new variables
574  };
575
576  matrix Rel = imap(@B, Rel); //consider the matrix of relations in new ring
577
578  int Sz = 2*NVars; // number of variables in new ring
579
580  matrix M[Sz][Sz]; //to be the matrix of relations in new ring
581  for(i=1; i<NVars; i++) //initialize that matrix of relations
582  {
583    for(j=i+1; j<=NVars; j++)
584    {
585      M[i,j] = Rel[i,j];
586    };
587  };
588
589  ncalgebra(1, M); //now new ring @@K become a noncommutative ring
590
591  list l; //list to define an involution
592
593  for(i=1; i<=NVars; i++) //initializing list for involution
594  {
595    execute( "l["+string(i)+"]="+NVAR(i,i)+"*"+string( var(i) )+";" );
596
597  };
598  matrix N = Rel; //imap(@B,Rel);
599
600  for(i=1; i<NVars; i++)//get matrix by applying the involution to relations
601  {
602    for(j=i+1; j<=NVars; j++)
603    {
604      N[i,j]= l[j]*l[i] - l[i]*l[j] + In_Poly( N[i,j], l, NVars);
605    };
606  };
607  kill l;
608  //---------------------------------------------
609  //get the ideal of coefficients of N
610
611  ideal J;
612  ideal idN = simplify(ideal(N),2);
613  J = ideal(coeffs( idN, var(1) ) );
614  for(i=2; i<=NVars; i++)
615  {
616    J = ideal( coeffs( J, var(i) ) );
617  };
618  J = simplify(J,2);
619  //-------------------------------------------------
620
621  if ( Par=="" ) //initializes the ring of relations
622  {
623    execute("ring @@KK=0,("+s+"), dp;");
624  }
625  else
626  {
627    execute("ring @@KK=(0,"+Par+"),("+s+"), dp;");
628  };
629
630  ideal J = imap(@@K,J); // ideal, considered in @@KK now
631
632  matrix @@D[NVars][NVars]; // matrix with entries=new variables to square i.e. @@D=@@D^2
633  for(i=1;i<=NVars;i++)
634  {
635    execute("@@D["+string(i)+","+string(i)+"]="+NVAR(i,i)+";");
636  };
637  J = J, ideal( @@D*@@D - matrix( freemodule(NVars) ) ); // add the condition that involution to square is just identity
638  J = simplify(J,2); // without extra zeros
639
640  list mL = minAssGTZ(J); // components not in GB
641  int sL  = size(mL);
642  option(redSB); // important for reduced GBs
643  option(redTail);
644  matrix IM = @@D; // involution map
645  list L = list(); // the answer
646  list TL;
647  ideal tmp = 0;
648  for (i=1; i<=sL; i++) // compute GBs of components
649  {
650    TL    = list();
651    TL[1] = std(mL[i]);
652    tmp   = NF( ideal(IM), TL[1] );
653    TL[2] = matrix(tmp, NVars,NVars);
654    L[i]  = TL;
655  }
656  export(L);
657  ideal idJ = J; // debug-comfortable exports
658  matrix matD = @@D;
659  export(idJ);
660  export(matD);
661  return(@@KK);
662}
663example
664{ "EXAMPLE:"; echo = 2;
665 def a = makeWeyl(1);
666 setring a; // this algebra is a first Weyl algebra
667 def X = findInvoDiag();
668 setring X; // ring with new variables, corresponding to unknown coefficients
669 // print matrices, defining linear involutions
670 print(L[1][2]);  // a first matrix: we see it is constant
671 print(L[2][2]);  // and a second possible matrix; it is constant too
672 L; // let us take a look on the whole list
673}
674/////////////////////////////////////////////////////////////////////
675proc findAuto()
676"USAGE: findAuto();
677RETURN: a ring together with a list of pairs L, where
678@*        L[i][1]  =  Groebner Basis of an i-th associated prime,
679@*        L[i][2]  =  matrix, defining a linear map, with entries, reduced with respect to L[i][1]
680PURPOSE: computes the ideal of linear automorphisms of the basering
681NOTE: for convenience, the full ideal of relations @code{idJ}
682and the initial matrix with indeterminates @code{matD} are exported in the output ring
683SEE ALSO: findInvo
684EXAMPLE: example findAuto; shows examples
685"{
686  def @B    = basering; //save the name of basering
687  int NVars = nvars(@B); //number of variables in basering
688  int i, j;
689
690  matrix Rel = RelMatr(); //the matrix of relations
691
692  string s   = new_var(); //string of new variables
693  string Par = parstr(@B); //string of parameters in old ring
694
695  if (Par=="") // if there are no parameters
696  {
697    execute("ring @@K=0,("+varstr(@B)+","+s+"), dp;"); //new ring with new variables
698  }
699  else //if there exist parameters
700  {
701     execute("ring @@K=(0,"+Par+") ,("+varstr(@B)+","+s+"), dp;");//new ring with new variables
702  };
703
704  matrix Rel = imap(@B, Rel); //consider the matrix of relations in new ring
705
706  int Sz = NVars*NVars+NVars; // number of variables in new ring
707
708  matrix M[Sz][Sz]; //to be the matrix of relations in new ring
709
710  for(i=1; i<NVars; i++) //initialize that matrix of relations
711  {
712    for(j=i+1; j<=NVars; j++)
713    {
714      M[i,j] = Rel[i,j];
715    };
716  };
717
718  ncalgebra(1, M); //now new ring @@K become a noncommutative ring
719
720  list l; //list to define a homomorphism(isomorphism)
721  poly @@F;
722  for(i=1; i<=NVars; i++) //initializing list for involution
723  {
724    @@F=0;
725    for(j=1; j<=NVars; j++)
726    {
727      execute( "@@F = @@F+"+NVAR(i,j)+"*"+string( var(j) )+";" );
728    };
729    l=l+list(@@F);
730  };
731
732  matrix N = Rel; //imap(@B,Rel);
733
734  for(i=1; i<NVars; i++)//get matrix by applying the homomorphism  to relations
735  {
736    for(j=i+1; j<=NVars; j++)
737    {
738      N[i,j]= l[j]*l[i] - l[i]*l[j] - Hom_Poly( N[i,j], l, NVars);
739    };
740  };
741  kill l;
742  //---------------------------------------------
743  //get the ideal of coefficients of N
744  ideal J;
745  ideal idN = simplify(ideal(N),2);
746  J = ideal(coeffs( idN, var(1) ) );
747  for(i=2; i<=NVars; i++)
748  {
749    J = ideal( coeffs( J, var(i) ) );
750  };
751  J = simplify(J,2);
752  //-------------------------------------------------
753  if ( Par=="" ) //initializes the ring of relations
754  {
755    execute("ring @@KK=0,("+s+"), dp;");
756  }
757  else
758  {
759    execute("ring @@KK=(0,"+Par+"),("+s+"), dp;");
760  };
761  ideal J = imap(@@K,J); // ideal, considered in @@KK now
762  string snv = "["+string(NVars)+"]";
763  execute("matrix @@D"+snv+snv+"="+s+";"); // matrix with entries=new variables
764
765  J = J, ideal( @@D*@@D-matrix( freemodule(NVars) ) ); // add the condition that homomorphism to square is just identity
766  J       = simplify(J,2); // without extra zeros
767  list mL = minAssGTZ(J); // components not in GB
768  int sL  = size(mL);
769  option(redSB); // important for reduced GBs
770  option(redTail);
771  matrix IM = @@D; //  map
772  list L = list(); // the answer
773  list TL;
774  ideal tmp = 0;
775  for (i=1; i<=sL; i++)// compute GBs of components
776  {
777    TL    = list();
778    TL[1] = std(mL[i]);
779    tmp   = NF( ideal(IM), TL[1] );
780    TL[2] = matrix(tmp,NVars, NVars);
781    L[i]  = TL;
782  }
783  export(L);
784  ideal idJ = J; // debug-comfortable exports
785  matrix matD = @@D;
786  export(idJ);
787  export(matD);
788  return(@@KK);
789}
790example
791{ "EXAMPLE:"; echo = 2;
792 def a = makeWeyl(1);
793 setring a; // this algebra is a first Weyl algebra
794 def X = findAuto();
795 setring X; // ring with new variables - unknown coefficients
796 // look at matrices, defining linear automorphisms:
797 print(L[1][2]);  // a first one: we see it is constant
798 print(L[2][2]);  // and a second possible matrix; it is constant too
799 L; // let us take a look on the whole list
800}
Note: See TracBrowser for help on using the repository browser.