source: git/Singular/LIB/jacobson.lib @ 4f950e

spielwiese
Last change on this file since 4f950e was 4f950e, checked in by Viktor Levandovskyy <levandov@…>, 15 years ago
*levandov: Smith and Jacobson normal forms: first release git-svn-id: file:///usr/local/Singular/svn/trunk@11109 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100755
File size: 21.7 KB
Line 
1//////////////////////////////////////////////////////////////////////////////
2version="$Id: jacobson.lib,v 1.1 2008-10-07 17:49:06 levandov Exp $";
3category="Noncommutative";
4info="
5LIBRARY: jacobson.lib     Algorithms for Smith and Jacobson Normal Form
6AUTHOR: Kristina Schindelar,     Kristina.Schindelar@math.rwth-aachen.de
7
8THEORY: We work over a ring R, that is a principal ideal domain.
9@*  If R is commutative, we suppose R to be a polynomial ring in one variable.
10@*  If R is non-commutative, we suppose R to be in two variables, say x and d. We treat
11@* then the Ore localization of R with respect to the mult.closed set S = K[x] without 0.
12@*  Given a rectangular matrix M over R, one can compute unimodular matrices U, V
13@*  such that U*M*V=D is a diagonal matrix.
14@*  Depending on the ring, the diagonal entries of D have certain properties.
15
16MAIN PROCEDURES:
17smith(R,M[,eng1,eng2]);  compute the Smith Normal Form of M over commutative ring
18jacobson(R,M[,eng]);       compute a weak Jacobson Normal Form of M over non-commutative ring, i.e. a diagonal matrix
19";
20  LIB "poly.lib";
21  LIB "involut.lib";
22
23proc smith(R, matrix MA, list #)
24"USAGE:  smith(R, M[, eng1, eng2]);  R ring, M matrix, eng1 and eng2 are optional int
25RETURN: list
26NOTE: By default, the diagonal matrix, the Smith normal form, is returned.
27@* If optional integer eng1 is nonzero, smith returns
28@* a list of matrices L such that L[1]*M*L[3]=L[2] with L[2]_11|L[2]_22|...|L[2]_nn and
29@* L[1], L[3] unimodular matrices.
30@* eng2 determines the engine, that computes the Groebner basis. By default eng2 equals zero.
31@* If optional integer eng2 = 0 than std is used to caculate a Groebner basis ,
32@* If eng2 = 1 than groebner is used to caculate a Groebner basis
33@* If eng2 = 2 than slimgb is used to caculate a Groebner basis
34@* If @code{printlevel}=1, progress debug messages will be printed,
35@* if @code{printlevel}>=2, all the debug messages will be printed.
36EXAMPLE: example smith; shows examples
37"
38{
39  int eng = 0;
40  int BASIS;
41  if ( size(#)>0 )
42  {
43    eng=1;
44    if (typeof(#[1])=="int")
45    {
46      eng=int(#[1]); // zero can also happen
47    }
48  }
49  if (size(#)==2)
50  {
51  BASIS=#[2];
52  }
53  else{BASIS=0;}
54 
55
56  int ROW=ncols(MA);
57  int COL=nrows(MA);
58
59  //generate a module consisting of the columns of MA
60  module m=MA[1];
61  int i;
62  for(i=2;i<=ROW;i++)
63  {
64    m=m,MA[i];
65  }
66
67  //if MA eqauls the zero matrix give back MA
68  if ( (size(m)==0) and (size(transpose(m))==0) )
69  {
70    module L=freemodule(COL);
71    matrix LM=L;
72    L=freemodule(ROW);
73    matrix RM=L;
74    list RUECK=RM;
75    RUECK=insert(RUECK,MA);
76    RUECK=insert(RUECK,LM);
77    return(RUECK);
78  }
79
80  if(eng==1)
81  {
82    list rueckLI=diagonal_with_trafo(R,MA,BASIS);
83    list rueckLII=divisibility(rueckLI[2]);
84    matrix CON=divideByContent(rueckLII[2]);
85    list rueckL=CON*rueckLII[1]*rueckLI[1], CON*rueckLII[2], rueckLI[3]*rueckLII[3];
86    return(rueckL);
87  }
88  else
89  {
90    matrix rueckm=diagonal_without_trafo(R,MA,BASIS);
91    list rueckL=divisibility(rueckm);
92    matrix CON=divideByContent(rueckm);
93    rueckm=CON*rueckL[2];
94    return(rueckm);
95  }
96}
97example
98{ "EXAMPLE:"; echo = 2;
99  ring r = 0,x,Dp;
100  matrix m[3][2]=x, x^4+x^2+21, x^4+x^2+x, x^3+x, 4*x^2+x, x;
101  list s=smith(r,m,1);
102  print(s[2]);
103  print(s[1]*m*s[3]);
104}
105proc diagonal_with_trafo( R, matrix MA, int B)
106{
107
108int ppl = printlevel-voice+2;
109
110  int BASIS=B;
111  int ROW=ncols(MA);
112  int COL=nrows(MA);
113  module m=MA[1];
114  int i,j,k;
115  for(i=2;i<=ROW;i++)
116  {
117    m=m,MA[i];
118  }
119
120
121  //add zero rows or columns
122  //add zero rows or columns
123  int adrow=0;
124  for(i=1;i<=COL;i++)
125  {
126  k=0;
127  for(j=1;j<=ROW;j++)
128  {
129  if(MA[i,j]!=0){k=1;}
130  }
131  if(k==0){adrow++;}
132  }
133   
134    m=transpose(m);
135    for(i=1;i<=adrow;i++){m=m,0;}
136    m=transpose(m);
137
138  list RINGLIST=ringlist(R);
139  list o="C",0;
140  list oo="lp",1;
141  list ORD=o,oo;
142  RINGLIST[3]=ORD;
143  def r=ring(RINGLIST);
144  setring r;
145  //fix the required ordering
146  map MAP=R,var(1);
147  module m=MAP(m);
148
149  int flag=1;  ///////////////counts if the underlying ring is r (flag mod 2 == 1) or ro (flag mod 2 == 0)
150
151    module TrafoL=freemodule(COL);
152    module TrafoR=freemodule(ROW);
153    module EXL=freemodule(COL); //because we start with transpose(m)
154    module EXR=freemodule(ROW);
155
156    option(redSB);
157    option(redTail);
158    module STD_EX;
159    module Trafo;
160
161    int s,st,p,ff;
162   
163    module LT,TSTD;
164    module STD=transpose(m);
165    int finish=0;
166    int fehlpos;
167    list pos;
168    matrix END;
169    matrix ENDSTD;
170    matrix STDFIN;
171    STDFIN=STD;
172    list COMPARE=STDFIN;
173
174    while(finish==0)
175    {
176      dbprint(ppl,"Going into the while cycle");
177
178      if(flag mod 2==1)
179      {
180        STD_EX=EXL,transpose(STD);
181      }
182      else
183      {
184        STD_EX=EXR,transpose(STD);
185      }
186        dbprint(ppl,"Computing Groebner basis: start");
187        dbprint(ppl-1,STD);
188      STD=engine(STD,BASIS);
189        dbprint(ppl,"Computing Groebner basis: finished");
190        dbprint(ppl-1,STD);
191
192      if(flag mod 2==1){s=ROW; st=COL;}else{s=COL; st=ROW;}
193        dbprint(ppl,"Computing Groebner basis for transformation matrix: start");
194        dbprint(ppl-1,STD_EX);
195      STD_EX=transpose(STD_EX);
196      STD_EX=engine(STD_EX,BASIS);
197        dbprint(ppl,"Computing Groebner basis for transformation matrix: finished");
198        dbprint(ppl-1,STD_EX);
199
200      //////// split STD_EX in STD and the transformation matrix
201      STD_EX=transpose(STD_EX);
202      STD=STD_EX[st+1];
203      LT=STD_EX[1];
204
205      ENDSTD=STD_EX;
206      for(i=2; i<=ncols(ENDSTD); i++)
207      {
208        if (i<=st)
209        {
210         LT=LT,STD_EX[i];
211        }
212        if (i>st+1)
213        {
214          STD=STD,STD_EX[i];
215        }
216      }
217
218      STD=transpose(STD);
219      LT=transpose(LT);
220
221      ////////////////////// compute the transformation matrices
222     
223      if (flag mod 2 ==1)
224      {
225        TrafoL=transpose(LT)*TrafoL;
226      }
227      else
228      {
229        TrafoR=TrafoR*LT;
230      }
231
232
233      STDFIN=STD;
234      /////////////////////////////////// check if the D-th row is finished ///////////////////////////////////
235      COMPARE=insert(COMPARE,STDFIN);
236        if(size(COMPARE)>=3)
237       {   
238        if(STD==COMPARE[3]){finish=1;}
239       }
240////////////////////////////////// change to the opposite module
241       TSTD=transpose(STD);
242       STD=TSTD;
243       flag++;
244      dbprint(ppl,"Finished one while cycle");
245    }
246
247
248   if (flag mod 2!=0) { STD=transpose(STD); }
249   
250   
251   //zero colums to the end
252    matrix STDMM=STD;
253    pos=list();
254    fehlpos=0;
255    while( size(STD)+fehlpos-ncols(STDMM) < 0)
256    {
257      for(i=1; i<=ncols(STDMM); i++)
258      {
259        ff=0;
260        for(j=1; j<=nrows(STDMM); j++)
261        {
262          if (STD[j,i]==0) { ff++; }
263        }
264        if(ff==nrows(STDMM))
265        {
266          pos=insert(pos,i); fehlpos++;
267        }
268      }
269    }
270    int fehlposc=fehlpos;
271    module SORT;
272    for(i=1; i<=fehlpos; i++)
273    {
274      SORT=gen(2);
275      for (j=3;j<=ROW;j++)
276      {
277        SORT=SORT,gen(j);
278      }
279      SORT=SORT,gen(1);
280      STD=STD*SORT;
281      TrafoR=TrafoR*SORT;
282    }
283
284    //zero rows to the end
285    STDMM=transpose(STD);
286    pos=list();
287    fehlpos=0;
288    while( size(transpose(STD))+fehlpos-ncols(STDMM) < 0)
289    {
290      for(i=1; i<=ncols(STDMM); i++)
291      {
292        ff=0; for(j=1; j<=nrows(STDMM); j++)
293        {
294           if(transpose(STD)[j,i]==0){ ff++;}}
295           if(ff==nrows(STDMM)) { pos=insert(pos,i); fehlpos++; }
296      }
297    }
298    int fehlposr=fehlpos;
299
300    for(i=1; i<=fehlpos; i++)
301    {
302      SORT=gen(2);
303      for(j=3;j<=COL;j++){SORT=SORT,gen(j);}
304      SORT=SORT,gen(1);
305      SORT=transpose(SORT);
306      STD=SORT*STD;
307      TrafoL=SORT*TrafoL;
308    }
309     
310    setring R;
311    map MAPinv=r,var(1);
312    module STD=MAPinv(STD);
313    module TrafoL=MAPinv(TrafoL);
314    matrix TrafoLM=TrafoL;
315    module TrafoR=MAPinv(TrafoR);
316    matrix TrafoRM=TrafoR;
317    matrix STDM=STD;
318
319    //Test
320    if(TrafoLM*m*TrafoRM!=STDM){ return(0); }
321   
322    list RUECK=TrafoRM;
323    RUECK=insert(RUECK,STDM);
324    RUECK=insert(RUECK,TrafoLM);
325    return(RUECK);
326}
327
328
329proc divisibility(matrix M)
330   {
331    matrix STDM=M;
332    int i,j;
333    int ROW=nrows(M);
334    int COL=ncols(M);
335    module TrafoR=freemodule(COL);
336    module TrafoL=freemodule(ROW);
337    module SORT;
338    matrix TrafoRM=TrafoR;
339    matrix TrafoLM=TrafoL;
340    list posdeg0;
341    int posdeg=0;
342    int act;
343    int Sort=ROW;
344    if(size(std(STDM))!=0)
345    { while( size(transpose(STDM)[Sort])==0 ){Sort--;}}
346
347    for(i=1;i<=Sort ;i++)
348    {
349      if(leadexp(STDM[i,i])==0){posdeg0=insert(posdeg0,i);posdeg++;}
350    }
351    //entries of degree 0 at the beginning
352    for(i=1; i<=posdeg; i++)
353    {
354      act=posdeg0[i];
355      SORT=gen(act);
356      for(j=1; j<=COL; j++){if(j!=act){SORT=SORT,gen(j);}}
357      STDM=STDM*SORT;
358      TrafoRM=TrafoRM*SORT;
359      SORT=gen(act);
360      for(j=1; j<=ROW; j++){if(j!=act){SORT=SORT,gen(j);}}
361      STDM=transpose(SORT)*STDM;
362      TrafoLM=transpose(SORT)*TrafoLM;
363    }
364
365    poly G;
366    module UNITL=freemodule(ROW);
367    matrix GCDL=UNITL;
368    module UNITR=freemodule(COL);
369    matrix GCDR=UNITR;
370    for(i=posdeg+1; i<=Sort; i++)
371    {
372      for(j=i+1; j<=Sort; j++)
373      {
374        GCDL=UNITL;
375        GCDR=UNITR;
376        G=gcd(STDM[i,i],STDM[j,j]);
377        ideal Z=STDM[i,i],STDM[j,j];
378        matrix T=lift(Z,G);
379        GCDL[i,i]=T[1,1];
380        GCDL[i,j]=T[2,1];
381        GCDL[j,i]=-STDM[j,j]/G;
382        GCDL[j,j]=STDM[i,i]/G;
383        GCDR[i,j]=T[2,1]*STDM[j,j]/G;
384        GCDR[j,j]=T[2,1]*STDM[j,j]/G-1;
385        GCDR[j,i]=1;
386        STDM=GCDL*STDM*GCDR;
387        TrafoLM=GCDL*TrafoLM;
388        TrafoRM=TrafoRM*GCDR;
389      }
390    }
391    list RUECK=TrafoRM;
392    RUECK=insert(RUECK,STDM);
393    RUECK=insert(RUECK,TrafoLM);
394    return(RUECK);
395}
396
397proc diagonal_without_trafo( R, matrix MA, int B)
398{
399  int ppl = printlevel-voice+2; 
400
401  int BASIS=B;
402  int ROW=ncols(MA);
403  int COL=nrows(MA);
404  module m=MA[1];
405  int i;
406  for(i=2;i<=ROW;i++)
407  {m=m,MA[i];}
408
409
410  list RINGLIST=ringlist(R);
411  list o="C",0;
412  list oo="lp",1;
413  list ORD=o,oo;
414  RINGLIST[3]=ORD;
415  def r=ring(RINGLIST);
416  setring r;
417  //RICHTIGE ORDNUNG MACHEN
418  map MAP=R,var(1);
419  module m=MAP(m);
420
421  int flag=1; ///////////////counts if the underlying ring is r (flag mod 2 == 1) or ro (flag mod 2 == 0)
422
423
424    int act, j, ff;
425    option(redSB);
426    option(redTail);
427
428
429    module STD=transpose(m);
430    module TSTD;
431    int finish=0;
432    matrix STDFIN;
433    STDFIN=STD;
434    list COMPARE=STDFIN;
435
436    while(finish==0)
437    {
438      dbprint(ppl,"Going into the while cycle");
439      dbprint(ppl,"Computing Groebner basis: start");
440      dbprint(ppl-1,STD);
441      STD=engine(STD,BASIS);
442      dbprint(ppl,"Computing Groebner basis: finished");
443      dbprint(ppl-1,STD);
444      STDFIN=STD;
445      /////////////////////////////////// check if the D-th row is finished ///////////////////////////////////
446      COMPARE=insert(COMPARE,STDFIN);
447        if(size(COMPARE)>=3)
448       {   
449        if(STD==COMPARE[3]){finish=1;}
450       }     
451        ////////////////////////////////// change to the opposite module
452
453        TSTD=transpose(STD);
454        STD=TSTD;
455        flag++;
456        dbprint(ppl,"Finished one while cycle");
457    }
458
459    matrix STDMM=STD;
460    list pos=list();
461    int fehlpos=0;
462    while( size(STD)+fehlpos-ncols(STDMM) < 0)
463    {
464      for(i=1; i<=ncols(STDMM); i++)
465      {
466        ff=0;
467        for(j=1; j<=nrows(STDMM); j++)
468        {
469          if (STD[j,i]==0) { ff++; }
470        }
471        if(ff==nrows(STDMM))
472        {
473          pos=insert(pos,i); fehlpos++;
474        }
475      }
476    }
477   int fehlposc=fehlpos;
478    module SORT;
479    for(i=1; i<=fehlpos; i++)
480    {
481      SORT=gen(2);
482      for (j=3;j<=ROW;j++)
483      {
484        SORT=SORT,gen(j);
485      }
486      SORT=SORT,gen(1);
487      STD=STD*SORT;
488    }
489
490    //zero rows to the end
491    STDMM=transpose(STD);
492    pos=list();
493    fehlpos=0;
494    while( size(transpose(STD))+fehlpos-ncols(STDMM) < 0)
495    {
496      for(i=1; i<=ncols(STDMM); i++)
497      {
498        ff=0; for(j=1; j<=nrows(STDMM); j++)
499        {
500           if(transpose(STD)[j,i]==0){ ff++;}}
501           if(ff==nrows(STDMM)) { pos=insert(pos,i); fehlpos++; }
502      }
503    }
504    int fehlposr=fehlpos;
505
506    for(i=1; i<=fehlpos; i++)
507    {
508      SORT=gen(2);
509      for(j=3;j<=COL;j++){SORT=SORT,gen(j);}
510      SORT=SORT,gen(1);
511      SORT=transpose(SORT);
512      STD=SORT*STD;
513    }
514   
515   //add zero rows or columns
516
517    int adrow=COL-size(transpose(STD));
518    int adcol=ROW-size(STD);
519
520    for(i=1;i<=adcol;i++){STD=STD,0;}
521    STD=transpose(STD);
522    for(i=1;i<=adrow;i++){STD=STD,0;}
523    STD=transpose(STD);
524
525    setring R;
526    map MAPinv=r,var(1);
527    module STD=MAPinv(STD);
528    matrix STDM=STD;
529    return(STDM);
530}
531
532
533
534static proc engine(module I, int i)
535{
536  module J;
537  if (i==0)
538  {
539    J = std(I);
540  }
541  if (i==1)
542  {
543    J = groebner(I);
544  }
545  if (i==2)
546  {
547    J = slimgb(I);
548  }
549  return(J);
550}
551
552proc jacobson(R, matrix MA, list #)
553 "USAGE:  jacobson(R, matrix MA, eng);  R ring, M matrix, eng an optional int
554RETURN: list
555NOTE: A list of matrices L such that L[1]*M*L[3]=L[2] such that L[2] is a diagonal matrix and
556@* L[1], L[3] unimodular matrices.
557@* eng determines the engine, that computes the Groebner basis. By default eng equals zero.
558@* If eng = 0 than std is used to caculate a Groebner basis
559@* If eng = 1 than groebner is used to caculate a Groebner basis
560@* If eng = 2 than slimgb is used to caculate a Groebner basis
561@* If @code{printlevel}=1, progress debug messages will be printed,
562@* if @code{printlevel}>=2, all the debug messages will be printed.
563EXAMPLE: example jacobson; shows examples
564"
565{
566  int B=0;
567  if ( size(#)>0 )
568  {
569    B=1;
570    if (typeof(#[1])=="int")
571    {
572    B=int(#[1]); // zero can also happen
573    }
574  }
575
576  //change ring
577  list RINGLIST=ringlist(R);
578  list o="C",0;
579  intvec v=1,0;
580  list oo="a",v;
581  v=1,1;
582  list ooo="lp",v;
583  list ORD=o,oo,ooo;
584  RINGLIST[3]=ORD;
585  def r=ring(RINGLIST);
586  setring r;
587 
588  //fix the required ordering
589  map MAP=R,var(1),var(2);
590  matrix M=MAP(MA);
591
592  module TrafoL, TrafoR;
593  list TRIANGLE;
594  TRIANGLE=triangle(M,B);
595  TrafoL=TRIANGLE[1];
596  TrafoR=TRIANGLE[3];
597  module m=TRIANGLE[2];
598
599  //back to the ring
600  setring R;
601  map MAPR=r,var(1),var(2);
602  module ma=MAPR(m);
603  matrix MAA=ma;
604  module TL=MAPR(TrafoL);
605  module TR=MAPR(TrafoR);
606  matrix CON=divideByContent(MAA);
607 
608list RUECK=CON*TL, CON*MAA, TR;
609return(RUECK);
610}
611example
612{ "EXAMPLE:"; echo = 2;
613  ring r = 0,(x,d),Dp;
614  def R=nc_algebra(1,1); // the Weyl algebra
615  setring R;
616  matrix m[2][2]=d,x,0,d; print(m);
617  list J=jacobson(R,m); // returns a list with 3 entries
618  print(J[2]); // a Jacobson Form D
619  print(J[1]*m*J[3]); // check that U*M*V = D
620}
621
622
623
624proc triangle( matrix MA, int B)
625{
626 int ppl = printlevel-voice+2;
627
628  map inv=ncdetection();
629  int ROW=ncols(MA);
630  int COL=nrows(MA);
631
632  //generate a module consisting of the columns of MA
633  module m=MA[1];
634  int i,j,s,st,p,k,ff,ex, nz, ii,nextp;
635  for(i=2;i<=ROW;i++)
636  {
637    m=m,MA[i];
638  }
639  int BASIS=B;
640
641  //add zero rows or columns
642  int adrow=0;
643  for(i=1;i<=COL;i++)
644  {
645  k=0;
646  for(j=1;j<=ROW;j++)
647  {
648  if(MA[i,j]!=0){k=1;}
649  }
650  if(k==0){adrow++;}
651  }
652
653    m=transpose(m);
654    for(i=1;i<=adrow;i++){m=m,0;}
655    m=transpose(m);
656
657
658    int flag=1;  ///////////////counts if the underlying ring is r (flag mod 2 == 1) or ro (flag mod 2 == 0)
659
660    module TrafoL=freemodule(COL);
661    module TrafoR=freemodule(ROW);
662    module EXL=freemodule(COL); //because we start with transpose(m)
663    module EXR=freemodule(ROW);
664
665    option(redSB);
666    option(redTail);
667    module STD_EX,LT,TSTD, L, Trafo;
668
669   
670   
671    module STD=transpose(m);
672    int finish=0;
673    list pos, COM, COM_EX;
674    matrix END, ENDSTD, STDFIN;
675    STDFIN=STD;
676    list COMPARE=STDFIN;
677
678
679  while(finish==0)
680    {
681      dbprint(ppl,"Going into the while cycle");
682      if(flag mod 2==1){STD_EX=EXL,transpose(STD); ex=2*COL;} else {STD_EX=EXR,transpose(STD); ex=2*ROW;}
683
684      dbprint(ppl,"Computing Groebner basis: start");
685      dbprint(ppl-1,STD);
686      STD=engine(STD,BASIS);
687      dbprint(ppl,"Computing Groebner basis: finished");
688      dbprint(ppl-1,STD);
689      if(flag mod 2==1){s=ROW; st=COL;}else{s=COL; st=ROW;}
690 
691      STD_EX=transpose(STD_EX);
692      dbprint(ppl,"Computing Groebner basis for transformation matrix: start");
693      dbprint(ppl-1,STD_EX);
694      STD_EX=engine(STD_EX,BASIS);
695      dbprint(ppl,"Computing Groebner basis for transformation matrix: finished");
696      dbprint(ppl-1,STD_EX);
697
698      COM=1;
699      COM_EX=1;
700      for(i=2; i<=size(STD); i++)
701         { COM=COM[1..size(COM)],i; COM_EX=COM_EX[1..size(COM_EX)],i; }
702      nz=size(STD_EX)-size(STD);
703
704      //zero rows in the begining
705
706       if(size(STD)!=size(STD_EX) )
707       {
708         for(i=1; i<=size(STD_EX)-size(STD); i++)
709         {
710           COM_EX=0,COM_EX[1..size(COM_EX)];
711         }
712       } 
713
714       
715       
716     
717       for(i=nz+1; i<=size(STD_EX); i++ )
718        {if( leadcoef(STD[i-nz])!=leadcoef(STD_EX[i]) )   {STD[i-nz]=leadcoef(STD_EX[i])*STD[i-nz];}
719        }
720
721        //assign the zero rows in STD_EX
722
723       for (j=2; j<=nz; j++)
724       {
725        p=0;
726        i=1;
727        while(STD_EX[j-1][i]==0){i++;};
728        p=i-1;
729        nextp=1;
730        k=0;
731        i=1;
732        while(STD_EX[j][i]==0 and i<=p)
733        { k++; i++;}
734        if (k==p){ COM_EX[j]=-1; }
735       }
736     
737      //assign the zero rows in STD
738      for (j=2; j<=size(STD); j++)
739       {
740        i=size(transpose(STD));
741        while(STD[j-1][i]==0){i--;}
742        p=i;
743        i=size(transpose(STD[j]));
744        while(STD[j][i]==0){i--;}
745        if (i==p){ COM[j]=-1; }
746       }
747
748       for(j=1; j<=size(COM); j++)
749        {
750        if(COM[j]<0){COM=delete(COM,j);}
751        }
752     
753      for(i=1; i<=size(COM_EX); i++)
754        {ff=0;
755         if(COM_EX[i]==0){ff=1;}
756         else
757          {  for(j=1; j<=size(COM); j++)
758               { if(COM_EX[i]==COM[j]){ff=1;} }
759          }
760         if(ff==0){COM_EX[i]=-1;}
761        }
762
763      L=STD_EX[1];
764      for(i=2; i<=size(COM_EX); i++)
765       {
766        if(COM_EX[i]!=-1){L=L,STD_EX[i];}
767       }
768
769      //////// split STD_EX in STD and the transformation matrix
770
771       L=transpose(L);
772       STD=L[st+1];
773       LT=L[1];
774
775     
776       for(i=2; i<=s+st; i++)
777        {
778         if (i<=st)
779          {
780           LT=LT,L[i];
781          }
782         if (i>st+1)
783          {
784          STD=STD,L[i];
785          }
786        }
787
788       STD=transpose(STD);
789       STDFIN=matrix(STD);
790       COMPARE=insert(COMPARE,STDFIN);
791       LT=transpose(LT);
792
793      ////////////////////// compute the transformation matrices
794     
795       if (flag mod 2 ==1)
796        {
797         TrafoL=transpose(LT)*TrafoL;
798        }
799       else
800        {
801         TrafoR=TrafoR*involution(LT,inv);
802        }
803
804
805      ///////////////////////// check whether the alg termined /////////////////
806      if(size(COMPARE)>=3)
807       {   
808        if(STD==COMPARE[3]){finish=1;}
809       }       
810       ////////////////////////////////// change to the opposite module
811       TSTD=transpose(STD);
812       STD=involution(TSTD,inv);
813       flag++;
814       dbprint(ppl,"Finished one while cycle");
815    }
816
817if (flag mod 2 ==0){ STD = involution(STD,inv);} else { STD = transpose(STD);  }
818 
819    list REVERSE=TrafoL,STD,TrafoR;
820    return(REVERSE);
821}
822
823static proc divideByContent(matrix M)
824{
825//find first entrie not equal to zero
826int i,k;
827k=1;
828vector CON;
829   for(i=1;i<=ncols(M);i++)
830   {
831    if(leadcoef(M[i])!=0){CON=CON+leadcoef(M[i])*gen(k); k++;}
832   }
833poly con=content(CON);
834matrix TL=1/con*freemodule(nrows(M));
835return(TL);
836}
837
838
839/////interesting examples for smith////////////////
840
841static proc Ex_One_wheeled_bicycle()
842{
843ring RA=(0,m), D, lp;
844matrix bicycle[2][3]=(1+m)*D^2, D^2, 1, D^2, D^2-1, 0;
845list s=smith(RA,bicycle, 1,0);
846print(s[2]);
847print(s[1]*bicycle*s[3]-s[2]);
848}
849
850
851static proc Ex_RLC-circuit()
852{
853ring RA=(0,m,R1,R2,L,C), D, lp;
854matrix  circuit[2][3]=D+1/(R1*C), 0, -1/(R1*C), 0, D+R2/L, -1/L;
855list s=smith(RA,circuit, 1,0);
856print(s[2]);
857print(s[1]*circuit*s[3]-s[2]);
858}
859
860
861static proc Ex_two_pendula()
862{
863ring RA=(0,m,M,L1,L2,m1,m2,g), D, lp;
864
865matrix pendula[3][4]=m1*L1*D^2,m2*L2*D^2,(M+m1+m2)*D^2,-1,m1*L1^2*D^2-m1*L1*g,0,m1*L1*D^2,0,0,
866m2*L2^2*D^2-m2*L2*g,m2*L2*D^2,0;
867list s=smith(RA,pendula, 1,0);
868print(s[2]);
869print(s[1]*pendula*s[3]-s[2]);
870}
871
872
873
874static proc Ex_linerized_satellite_in_a_circular_equatorial_orbit()
875{
876ring RA=(0,m,omega,r,a,b), D, lp;
877
878matrix satellite[4][6]=
879D,-1,0,0,0,0,
880-3*omega^2,D,0,-2*omega*r,-a/m,0,
8810,0,D,-1,0,0,
8820,2*omega/r,0,D,0,-b/(m*r);
883
884list s=smith(RA,satellite, 1,0);
885print(s[2]);
886print(s[1]*satellite*s[3]-s[2]);
887}
888
889static proc Ex_flexible_one_link_robot()
890{
891ring RA=(0,M11,M12,M13,M21,M22,M31,M33,K1,K2), D, lp;
892
893matrix robot[3][4]=M11*D^2,M12*D^2,M13*D^2,-1,M21*D^2,M22*D^2+K1,0,0,M31*D^2,0,M33*D^2+K2,0;
894list s=smith(RA,robot, 1,0);
895print(s[2]);
896print(s[1]*robot*s[3]-s[2]);
897}
898
899
900
901/////interesting examples for jacobson////////////////
902
903static proc Ex_compare_output_with_maple_package_JanetOre() 
904{   ring w = 0,(x,d),Dp;
905    def W=nc_algebra(1,1);
906    setring W;
907    matrix m[3][3]=[d2,d+1,0],[d+1,0,d3-x2*d],[2d+1, d3+d2, d2];
908    list J=jacobson(W,m,0);
909    print(J[1]*m*J[3]);
910    print(J[2]);
911    print(J[1]);
912    print(J[3]);
913    print(J[1]*m*J[3]-J[2]);
914}
915
916
917static proc Ex_cyclic()
918{   ring w = 0,(x,d),Dp;
919    def W=nc_algebra(1,1);
920    setring W;
921    matrix m[3][3]=d,0,0,x*d+1,d,0,0,x*d,d;
922    list J=jacobson(W,m,0);
923    print(J[1]*m*J[3]);
924    print(J[2]);
925    print(J[1]);
926    print(J[3]);
927    print(J[1]*m*J[3]-J[2]);
928}
929
Note: See TracBrowser for help on using the repository browser.