source: git/Tst/Buch/Proc_3_7_3.tst @ 1ebec3

spielwiese
Last change on this file since 1ebec3 was 891438c, checked in by Gerhard Pfister <pfister@…>, 23 years ago
*GP: initial release git-svn-id: file:///usr/local/Singular/svn/trunk@5579 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 3.4 KB
Line 
1LIB "tst.lib";
2tst_init();
3
4proc normalisation(ideal i)
5"USAGE:  list L=normalisation(i);  i prime ideal
6RETURN:  a list L of one ring L[1]=R; R contains the ideal
7         norid such that R/norid is the normalisation of
8         basering/i.
9NOTE:    to use the ring type def S=L[1];setring S;norid;
10"
11{
12   def BAS=basering;
13   list result;
14   ideal rf;
15   int   ds = -1;
16   int isIso;
17
18   if (typeof(attrib(i,"isIsolatedSingularity"))=="int")
19   {
20     if(attrib(i,"isIsolatedSingularity")==1){isIso=1;}
21   }
22
23   if(size(i)!=0)
24   {
25     list SM=mstd(i);
26     i=SM[2];
27     ideal SBi=SM[1];
28   
29     int n=nvars(BAS);
30     int d=dim(SBi);
31  //------------------- the singular locus ---------------
32     if(isIso)
33     {
34       list singM=maxideal(1), maxideal(1),
35       ds=0;
36     }
37     else
38     {
39       ideal sing=minor(jacob(i),n-d)+i;
40       list singM=mstd(sing);
41       ds=dim(singM[1]);
42      }
43     if(ds!=-1)
44     {
45  //----------------- computation of the radical ---------
46     
47     if (isIso)
48     {
49       ideal J=maxideal(1);
50     }
51     else
52     {
53       ideal J=radical(singM[2]);
54     }
55  //------------------ go to quotient ring ---------------
56       qring R=SBi;
57       ideal J=fetch(BAS,J);
58       ideal i=fetch(BAS,i);
59       poly p=J[1];
60  //-------- computation of p*Hom(J,J) as R-ideal---------
61       ideal f=quotient(p*J,J);
62       ideal rf = interred(reduce(f,std(p)));
63  // represents p*Hom(J,J)/p*R = Hom(J,J)/R
64     } 
65   } 
66  //-------- Test: Hom(J,J) == R ?, if yes, go home ------ 
67   if ( size(rf) == 0 )   
68   {
69      execute("ring newR="+charstr(basering)+",
70         ("+varstr(basering)+"),("+ordstr(basering)+");");
71      ideal norid=fetch(BAS,i);
72      export norid;
73      result=newR;
74      setring BAS;
75      return(result);
76   }
77//------------------- Case: Hom(J,J)!= R ------------------
78// create new ring and map form old ring, the ring
79// newR/SBi+syzf will be isomorphic to Hom(J,J) as R-module
80
81   f=p,rf;
82   //generates pJ:J mod(p), i.e. p*Hom(J,J)/p*R as R-module
83   int q=size(f);
84   module syzf=syz(f);
85   
86   ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),dp;
87   map psi1 = BAS,maxideal(1);
88   ideal SBi = psi1(SBi);
89   attrib(SBi,"isSB",1);
90
91   qring newRq = SBi;
92   map psi = R,ideal(X(1..nvars(R)));
93   ideal i = psi(i);
94   ideal f = psi(f);
95   module syzf = psi(syzf);
96
97//------- computation of Hom(J,J) as ring ----------------
98// determine kernel of:
99// R[T1,...,Tq] -> J:J >-> R[1/p]=R[t]/(t*p-1),
100// Ti -> fi/p -> t*fi (p=f1=f[1]), to get ring structure.
101// This is of course the same as the kernel of
102//  R[T1,...,Tq] -> pJ:J >-> R, Ti -> fi.
103// It is a fact, that the kernel is generated by the linear
104// and the quadratic relations
105
106   ideal pf=f[1]*f;
107   matrix T=matrix(ideal(T(1..q)),1,q);
108   ideal Lin = ideal(T*syzf); //the linear relations
109   
110   int ii,jj;
111   matrix A;
112   ideal Q;
113
114   for (ii=2; ii<=q; ii++ )
115   {
116      for ( jj=2; jj<=ii; jj++ )
117      {
118         A = lift(pf,f[ii]*f[jj]);
119         Q = Q, ideal(T(jj)*T(ii) - T*A);
120         //the quadratic relations
121      }
122   }
123   Q = Lin+Q;
124   Q = subst(Q,T(1),1);
125   Q = interred(reduce(Q,std(0)));
126
127   ring newR = char(R),(X(1..nvars(R)),T(2..q)),dp;
128   ideal k=imap(newRq,Q)+imap(newRq,i);
129   if(isIso)
130   {
131     attrib(k,"isIsolatedSingularity",1);
132   }   
133   result=normalisation(k);
134   setring BAS;
135   return(result);
136}
137
138LIB"primdec.lib";
139ring R=0, (x,y,z),dp;
140ideal I=zy2-zx3-x6;
141list nor=normalisation(I);
142def S=nor[1];
143setring S;
144norid;
145
146tst_status(1);$
Note: See TracBrowser for help on using the repository browser.