source: git/Singular/LIB/involut.lib @ 065ddc

spielwiese
Last change on this file since 065ddc was 065ddc, checked in by Viktor Levandovskyy <levandov@…>, 19 years ago
*levandov: docu and examples updated git-svn-id: file:///usr/local/Singular/svn/trunk@8132 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 21.3 KB
Line 
1version="$Id: involut.lib,v 1.5 2005-05-10 17:31:26 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:
19find_invo();          describes a variety of linear involutions on a basering;
20find_invo_diag();     describes a variety of homothetic (diagonal) involutions on a basering;
21find_auto();          describes a variety of linear automorphisms of a basering;
22ncdetection();  computes an ideal, presenting an involution map on some particular noncommutative algebras;
23involution(m, map 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  for(i=1; i<=NVars; i++)
369  {
370    for(j=1; j<=NVars; j++)
371    {
372      if(i*j!=1)
373      {
374        s = s+ ","+NVAR(i,j);
375      };
376    };
377  };
378  return(s);
379};
380
381static proc NVAR(int i, int j)
382{
383  return("@_"+string(i)+"_"+string(j));
384};
385///////////////////////////////////////////////////////////////////////////////////
386static proc new_var_special()
387//generates a string of new variables
388{
389  int NVars=nvars(basering);
390  int i;
391  string s="@_1_1";
392  for(i=2; i<=NVars; i++)
393  {
394    s = s+ ","+NVAR(i,i);
395  };
396  return(s);
397};
398///////////////////////////////////////////////////////////////////////////////////
399static proc RelMatr()
400// returns the matrix of relations
401// only Lie-type relations x_j x_i= x_i x_j + .. are taken into account
402{
403  int i,j;
404  int NVars = nvars(basering);
405  matrix Rel[NVars][NVars];
406  for(i=1; i<NVars; i++)
407  {
408    for(j=i+1; j<=NVars; j++)
409    {
410      Rel[i,j]=var(j)*var(i)-var(i)*var(j);
411    };
412  };
413  return(Rel);
414};
415/////////////////////////////////////////////////////////////////
416proc find_invo()
417"USAGE: find_invo();
418RETURN: a ring containing a list L of pairs, where
419@*        L[i][1]  =  Groebner Basis of an i-th associated prime,
420@*        L[i][2]  =  matrix, defining a linear map, with entries, reduced with respect to L[i][1]
421
422PURPOSE: computed the ideal of linear involutions of the basering
423
424NOTE: for convenience, the full ideal of relations @code{idJ}
425and the initial matrix with indeterminates @code{matD} are exported in the output ring.
426EXAMPLE: example find_invo; shows examples
427SEE ALSO: find_invo_diag, involution
428"{
429  def @B    = basering; //save the name of basering
430  int NVars = nvars(@B); //number of variables in basering
431  int i, j;
432
433  matrix Rel = RelMatr(); //the matrix of relations
434
435  string s   = new_var(); //string of new variables
436  string Par = parstr(@B); //string of parameters in old ring
437
438  if (Par=="") // if there are no parameters
439  {
440    execute("ring @@K=0,("+varstr(@B)+","+s+"), dp;"); //new ring with new variables
441  }
442  else //if there exist parameters
443  {
444     execute("ring @@K=(0,"+Par+") ,("+varstr(@B)+","+s+"), dp;");//new ring with new variables
445  };
446
447  matrix Rel = imap(@B, Rel); //consider the matrix of relations in new ring
448
449  int Sz = NVars*NVars+NVars; // number of variables in new ring
450
451  matrix M[Sz][Sz]; //to be the matrix of relations in new ring
452
453  for(i=1; i<NVars; i++) //initialize that matrix of relations
454  {
455    for(j=i+1; j<=NVars; j++)
456    {
457      M[i,j] = Rel[i,j];
458    };
459  };
460
461  ncalgebra(1, M); //now new ring @@K become a noncommutative ring
462
463  list l; //list to define an involution
464  poly @@F;
465  for(i=1; i<=NVars; i++) //initializing list for involution
466  {
467    @@F=0;
468    for(j=1; j<=NVars; j++)
469    {
470      execute( "@@F = @@F+"+NVAR(i,j)+"*"+string( var(j) )+";" );
471    };
472    l=l+list(@@F);
473  };
474
475  matrix N = Rel; //imap(@B,Rel);
476
477  for(i=1; i<NVars; i++)//get matrix by applying the involution to relations
478  {
479    for(j=i+1; j<=NVars; j++)
480    {
481      N[i,j]= l[j]*l[i] - l[i]*l[j] + In_Poly( N[i,j], l, NVars);
482    };
483  };
484  kill l;
485  //---------------------------------------------
486  //get the ideal of coefficients of N
487  ideal J;
488  ideal idN = simplify(ideal(N),2);
489  J = ideal(coeffs( idN, var(1) ) );
490  for(i=2; i<=NVars; i++)
491  {
492    J = ideal( coeffs( J, var(i) ) );
493  };
494  J = simplify(J,2);
495  //-------------------------------------------------
496  if ( Par=="" ) //initializes the ring of relations
497  {
498    execute("ring @@KK=0,("+s+"), dp;");
499  }
500  else
501  {
502    execute("ring @@KK=(0,"+Par+"),("+s+"), dp;");
503  };
504  ideal J = imap(@@K,J); // ideal, considered in @@KK now
505  string snv = "["+string(NVars)+"]";
506  execute("matrix @@D"+snv+snv+"="+s+";"); // matrix with entries=new variables
507
508  J = J, ideal( @@D*@@D-matrix( freemodule(NVars) ) ); // add the condition that involution to square is just identity
509  J = simplify(J,2); // without extra zeros
510  list mL = minAssGTZ(J); // components not in GB
511  int sL  = size(mL);
512  option(redSB);       // important for reduced GBs
513  option(redTail);
514  matrix IM = @@D;     // involution map
515  list L    = list();  // the answer
516  list TL;
517  ideal tmp = 0;
518  for (i=1; i<=sL; i++) // compute GBs of components
519  {
520    TL    = list();
521    TL[1] = std(mL[i]);
522    tmp   = NF( ideal(IM), TL[1] );
523    TL[2] = matrix(tmp, NVars,NVars);
524    L[i]  = TL;
525  }
526  export(L); // main export
527  ideal idJ = J; // debug-comfortable exports
528  matrix matD = @@D;
529  export(idJ);
530  export(matD);
531  return(@@KK);
532}
533example
534{ "EXAMPLE:"; echo = 2;
535 def a = CreateWeyl(1);
536 setring a; // this algebra is a first Weyl algebra
537 def X = find_invo();
538 setring X; // ring with new variables, corresponding to unknown coefficients
539 L;
540 print(L[1][2]);  // L[i][2] is a matrix in new variables, defining the linear involution
541 L[1][1];  // where new variables obey these relations
542}
543///////////////////////////////////////////////////////////////////////////
544proc find_invo_diag()
545"USAGE: find_invo_diag();
546RETURN: a ring together with a list of pairs L, where
547@*        L[i][1]  =  Groebner Basis of an i-th associated prime,
548@*        L[i][2]  =  matrix, defining a linear map, with entries, reduced with respect to L[i][1]
549
550PURPOSE: compute the ideal of homothetic (diagonal) involutions of the basering
551
552NOTE: for convenience, the full ideal of relations @code{idJ}
553and the initial matrix with indeterminates @code{matD} are exported in the output ring.
554EXAMPLE: example find_invo_diag; shows examples
555SEE ALSO: find_invo, involution
556"{
557  def @B    = basering; //save the name of basering
558  int NVars = nvars(@B); //number of variables in basering
559  int i, j;
560
561  matrix Rel = RelMatr(); //the matrix of relations
562
563  string s   = new_var_special(); //string of new variables
564  string Par = parstr(@B); //string of parameters in old ring
565
566  if (Par=="") // if there are no parameters
567  {
568    execute("ring @@K=0,("+varstr(@B)+","+s+"), dp;"); //new ring with new variables
569  }
570  else //if there exist parameters
571  {
572    execute("ring @@K=(0,"+Par+") ,("+varstr(@B)+","+s+"), dp;");//new ring with new variables
573  };
574
575  matrix Rel = imap(@B, Rel); //consider the matrix of relations in new ring
576
577  int Sz = 2*NVars; // number of variables in new ring
578
579  matrix M[Sz][Sz]; //to be the matrix of relations in new ring
580  for(i=1; i<NVars; i++) //initialize that matrix of relations
581  {
582    for(j=i+1; j<=NVars; j++)
583    {
584      M[i,j] = Rel[i,j];
585    };
586  };
587
588  ncalgebra(1, M); //now new ring @@K become a noncommutative ring
589
590  list l; //list to define an involution
591
592  for(i=1; i<=NVars; i++) //initializing list for involution
593  {
594    execute( "l["+string(i)+"]="+NVAR(i,i)+"*"+string( var(i) )+";" );
595
596  };
597  matrix N = Rel; //imap(@B,Rel);
598
599  for(i=1; i<NVars; i++)//get matrix by applying the involution to relations
600  {
601    for(j=i+1; j<=NVars; j++)
602    {
603      N[i,j]= l[j]*l[i] - l[i]*l[j] + In_Poly( N[i,j], l, NVars);
604    };
605  };
606  kill l;
607  //---------------------------------------------
608  //get the ideal of coefficients of N
609
610  ideal J;
611  ideal idN = simplify(ideal(N),2);
612  J = ideal(coeffs( idN, var(1) ) );
613  for(i=2; i<=NVars; i++)
614  {
615    J = ideal( coeffs( J, var(i) ) );
616  };
617  J = simplify(J,2);
618  //-------------------------------------------------
619
620  if ( Par=="" ) //initializes the ring of relations
621  {
622    execute("ring @@KK=0,("+s+"), dp;");
623  }
624  else
625  {
626    execute("ring @@KK=(0,"+Par+"),("+s+"), dp;");
627  };
628
629  ideal J = imap(@@K,J); // ideal, considered in @@KK now
630
631  matrix @@D[NVars][NVars]; // matrix with entries=new variables to square i.e. @@D=@@D^2
632  for(i=1;i<=NVars;i++)
633  {
634    execute("@@D["+string(i)+","+string(i)+"]="+NVAR(i,i)+";");
635  };
636  J = J, ideal( @@D*@@D - matrix( freemodule(NVars) ) ); // add the condition that involution to square is just identity
637  J = simplify(J,2); // without extra zeros
638
639  list mL = minAssGTZ(J); // components not in GB
640  int sL  = size(mL);
641  option(redSB); // important for reduced GBs
642  option(redTail);
643  matrix IM = @@D; // involution map
644  list L = list(); // the answer
645  list TL;
646  ideal tmp = 0;
647  for (i=1; i<=sL; i++) // compute GBs of components
648  {
649    TL    = list();
650    TL[1] = std(mL[i]);
651    tmp   = NF( ideal(IM), TL[1] );
652    TL[2] = matrix(tmp, NVars,NVars);
653    L[i]  = TL;
654  }
655  export(L);
656  ideal idJ = J; // debug-comfortable exports
657  matrix matD = @@D;
658  export(idJ);
659  export(matD);
660  return(@@KK);
661}
662example
663{ "EXAMPLE:"; echo = 2;
664 def a = CreateWeyl(1);
665 setring a; // this algebra is a first Weyl algebra
666 def X = find_invo_diag();
667 setring X; // ring with new variables, corresponding to unknown coefficients
668 print(L[1][2]);  // a first matrix, defining the linear involution: we see it is constant
669 print(L[2][2]);  // and a second possible matrix; it is constant too
670 L; // let us take a look on the whole list
671}
672/////////////////////////////////////////////////////////////////////
673proc find_auto()
674"USAGE: find_auto();
675RETURN: a ring together with a list of pairs L, where
676@*        L[i][1]  =  Groebner Basis of an i-th associated prime,
677@*        L[i][2]  =  matrix, defining a linear map, with entries, reduced with respect to L[i][1]
678
679PURPOSE: computes the ideal of linear automorphisms of the basering
680
681NOTE: for convenience, the full ideal of relations @code{idJ}
682and the initial matrix with indeterminates @code{matD} are exported in the output ring.
683EXAMPLE: example find_auto; shows examples
684SEE ALSO: find_invo
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 = CreateWeyl(1);
793 setring a; // this algebra is a first Weyl algebra
794 def X = find_auto();
795 setring X; // ring with new variables, corresponding to unknown coefficients
796 print(L[1][2]);  // a first matrix, defining the linear automorphism : we see it is constant
797 print(L[2][2]);  // and a second possible matrix; it is constant too
798 L; // let us take a look on the whole list
799}
Note: See TracBrowser for help on using the repository browser.