Annotation of OpenXM/src/k097/lib/minimal/cohom.k, Revision 1.5
1.5 ! takayama 1: /* $OpenXM: OpenXM/src/k097/lib/minimal/cohom.k,v 1.4 2000/11/19 05:50:30 takayama Exp $ */
1.1 takayama 2:
1.2 takayama 3: /* k0 interface functions for cohom.sm1 */
1.1 takayama 4: def Boundp(a) {
5: local b;
6: sm1("[(parse) [(/) ",a," ( load tag 0 eq
7: { /FunctionValue 0 def }
8: { /FunctionValue 1 def } ifelse )] cat ] extension");
9: }
10:
11: def load_cohom() {
12: if (Boundp("cohom.sm1.loaded")) {
13: }else{
14: sm1(" [(parse) (k0-cohom.sm1) pushfile ] extension ");
15: }
16: }
17:
18: load_cohom();
19:
20: def sm1_deRham(a,b) {
21: local aa,bb;
22: aa = ToString(a);
23: if (IsArray(b)) {
24: bb = Map(b,"ToString");
25: }else{
26: bb = ToString(b);
27: }
28: sm1("[", aa,bb, " ] deRham /FunctionValue set ");
29: }
1.4 takayama 30: HelpAdd(["sm1_deRham",
31: ["sm1_deRham(f,v) computes the dimension of the deRham cohomology groups",
32: "of C^n - V(f)",
33: "This function does not use (-w,w)-minimal free resolution.",
34: "Example: sm1_deRham(\"x^3-y^2\",\"x,y\");"
35: ]]);
1.1 takayama 36:
37:
38: def Weyl(v,w,p) {
39: local a,L;
40: L=Length(Arglist);
41: if (L == 1) {
42: a=RingD(v);
43: } else if (L == 2) {
44: a=RingD(v,w);
45: }else if (L == 3) {
46: a=RingD(v,w,p);
47: }else{
48: Println("Error: argument mismatch");
49: return(null);
50: }
51: sm1(" define_ring_variables ");
52: return(a);
53: }
1.4 takayama 54: HelpAdd(["Weyl",
55: [ "Weyl(v,w) defines the Weyl algebra (the ring of differential operators)",
56: "with the weight vector w.",
57: "Example: Weyl(\"x,y\",[[\"x\",-1,\"Dx\",1]]); "
58: ]]);
59: /* ( and ) must match in HelpAdd. */
1.1 takayama 60:
61: def sm1_pmat(a) {
62: sm1(a," pmat ");
63: }
64:
65: Weyl("x,y");
66: /* See page 8, (2.2). */
67: cech=[
68: [ [x*Dx],
69: [y*Dy]
70: ],
71: [[ y*Dy, -x*Dx]]
72: ];
73:
74: def sm1_v_string(V) {
75: if (IsArray(V)) {
76: V = Map(V,"ToString");
77: }else {
78: V = ToString(V);
79: }
80: return(V);
81: }
82:
83: def sm1_syz(A,V,W) {
84: local L,P;
85: L=Length(Arglist);
86: if (L == 1) {
87: P = [A];
88: }else if (L==2) {
89: V = sm1_v_string(V);
90: P = [A,V];
91: }else if (L==3) {
92: P = [A,V,W];
93: }else {
94: Println("sm1_syz: Argument mismatch");
95: return(null);
96: }
97: sm1(P," syz /FunctionValue set");
98: }
99: /*
1.5 ! takayama 100: cf. Kernel()
1.1 takayama 101: sm1_syz([x*Dx,y*Dy],[x,y]):
102: We want to syz_h, too.
103: Step 1: Control by global variable ? syz ==> syz_generic
104: Step 2: syz and syz_h
105: */
106:
107: def sm1_resol1(I,V,W) {
108: local P,L;
109: L=Length(Arglist);
110: if (L == 1) {
111: P = [I];
112: }else if (L==2) {
113: V = sm1_v_string(V);
114: P = [I,V];
115: }else if (L==3) {
116: P = [I,V,W];
117: }else {
118: Println("sm1_syz: Argument mismatch");
119: return(null);
120: }
121: sm1(P," resol1 /FunctionValue set ");
122: }
123: /* sm1_resol1([x^2,x*y],[x,y]): */
124:
125: def sm1_res_solv(A,B,C) {
126: local P,L;
127: L=Length(Arglist);
128: if (L == 2) {
129: P = [A,B];
130: sm1(P," res-solv /FunctionValue set");
131: }else if (L==3) {
132: C = sm1_v_string(C);
133: P = [[A,B], C];
134: sm1(P," res*solv /FunctionValue set ");
135: }else{
136: Println("Error: argument mismatch");
137: return(null);
138: }
139: }
140: /*
141: sm1_res_solv(
142: [[x*Dx + 2, 0],
143: [Dx+3, x^3],
144: [3, x],
145: [Dx*(x*Dx + 3) - (x*Dx + 2)*(x*Dx -4), 0]],
146: [1, 0], [x,y]):
147:
148: sm1_res_solv([x,1],1,"x"):
149: sm1_res_solv([x,y],y,"x,y"):
150: */
151:
152: def sm1_res_solv_h(A,B,C) {
153: local P;
154: P = [[A,B], C];
155: sm1(P," res*solv*h /FunctionValue set ");
156: }
157:
158: def Reparse(A) {
159: if (IsArray(A)) {
160: return(Map(A,"Reparse"));
161: }else if (IsPolynomial(A) || IsInteger(A)) {
162: return(Poly(ToString(A)));
163: }else{
164: return(A);
165: }
166: }
167:
168: def sm1_res_sub2Q(I,V) {
169: local L,P;
170: L = Length(Arglist);
171: if (L == 1) {
172: P = I;
173: }else if ( L == 2) {
174: V = sm1_v_string(V);
175: if (IsArray(V)) {
176: sm1(V," from_records /V set ");
177: }
178: Weyl(V);
179: P = Reparse(I);
180: }
181: sm1(P," res-sub2Q /FunctionValue set ");
182: }
183:
184: /*
185: sm1_res_sub2Q([x*Dx,Dy]):
186: M res-sub2Q =: J, M \simeq D^p/J
187: */
188:
189: def ex2_9() {
190: Weyl("x,y,z");
191: I = [ x*Dx+y*Dy+z*Dz+6,
192: z^2*Dy-y^2*Dz,
193: z^2*Dx-x^2*Dz,
194: y^2*Dx-x^2*Dy,
195: x^3*Dz+y^3*Dz+z^3*Dz+6*z^2,
196: x^3*Dy+y^3*Dy+y^2*z*Dz+6*y^2];
197: a = sm1_resol1(I,"x,y,z");
198: return(a);
199: }
200:
1.2 takayama 201: def to_int0(A) {
202: local i,c,n,r;
203: if (IsArray(A)) {
204: n = Length(A);
205: r = NewArray(n);
206: for (i=0; i<n; i++) {
207: r[i] = to_int0(A[i]);
208: }
209: return(r);
210: } else if (IsInteger(A)) {
211: return(IntegerToSm1Integer(A));
212: } else {
213: return(A);
214: }
215: }
216: HelpAdd(["Translate.to_int0",
217: ["to_int0(a) : as same as sm1_push_int0."]]);
218:
219:
220: def GKZ(A,B) {
221: /* we need sm1_rat_to_p in a future. */
222: local c;
223: c = to_int0([A,B]);
224: sm1(c," gkz /FunctionValue set ");
225: }
226: HelpAdd(["GKZ.GKZ",
227: ["GKZ(a,b) returns the GKZ systems associated to the matrix a and the vector b",
228: "The answer is given by strings.",
1.4 takayama 229: "Example: GKZ([[1,1,1,1],[0,1,3,4]],[0,2]);"]]);
1.3 takayama 230:
231: def ToricIdeal(A) {
232: /* we need sm1_rat_to_p in a future. */
233: local c,B,i,n,pp;
234: n = Length(A);
235: B = NewArray(n);
236: for (i=0; i<n; i++) {B[i] = 0;}
237: c = to_int0([A,B]);
238: sm1(c," gkz 0 get /pp set ");
239: for (i=0; i<n; i++) { pp = Rest(pp); }
240: return(pp);
241: }
242: HelpAdd(["ToricIdeal",
243: ["ToricIdeal(a) returns the affine toric ideal associated to the matrix a",
244: "The answer is given by a list of strings.",
1.4 takayama 245: "Example: ToricIdeal([[1,1,1,1],[0,1,3,4]]);"]]);
1.2 takayama 246:
247: def Rest(a) {
248: sm1(a," rest /FunctionValue set ");
249: }
250: HelpAdd(["Rest",
1.5 ! takayama 251: ["Rest(a), list a; "]]);
! 252:
! 253: def Annfs(f,v) {
! 254: local fs;
! 255: fs = ToString(f);
! 256: sm1(" [fs v] annfs /FunctionValue set ");
! 257: }
! 258: HelpAdd(["Annfs",
! 259: ["Annfs(f,v) computes the annihilating ideal of f^r and the Bernstein-Sato",
! 260: " polynomial b(s) of f",
! 261: "Return value: [Ann(f^r), r, b(s)] where r is the minimal integral root of",
! 262: " b(s) = 0.",
! 263: "Example: Annfs(x^2+y^2,\"x,y\"): "
! 264: ]]);
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to cohom.k CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / lib / minimal