Annotation of OpenXM/src/k097/lib/minimal/cohom.k, Revision 1.4
1.4 ! takayama 1: /* $OpenXM: OpenXM/src/k097/lib/minimal/cohom.k,v 1.3 2000/09/10 20:22:45 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: /*
100: sm1_syz([x*Dx,y*Dy],[x,y]):
101: We want to syz_h, too.
102: Step 1: Control by global variable ? syz ==> syz_generic
103: Step 2: syz and syz_h
104: */
105:
106: def sm1_resol1(I,V,W) {
107: local P,L;
108: L=Length(Arglist);
109: if (L == 1) {
110: P = [I];
111: }else if (L==2) {
112: V = sm1_v_string(V);
113: P = [I,V];
114: }else if (L==3) {
115: P = [I,V,W];
116: }else {
117: Println("sm1_syz: Argument mismatch");
118: return(null);
119: }
120: sm1(P," resol1 /FunctionValue set ");
121: }
122: /* sm1_resol1([x^2,x*y],[x,y]): */
123:
124: def sm1_res_solv(A,B,C) {
125: local P,L;
126: L=Length(Arglist);
127: if (L == 2) {
128: P = [A,B];
129: sm1(P," res-solv /FunctionValue set");
130: }else if (L==3) {
131: C = sm1_v_string(C);
132: P = [[A,B], C];
133: sm1(P," res*solv /FunctionValue set ");
134: }else{
135: Println("Error: argument mismatch");
136: return(null);
137: }
138: }
139: /*
140: sm1_res_solv(
141: [[x*Dx + 2, 0],
142: [Dx+3, x^3],
143: [3, x],
144: [Dx*(x*Dx + 3) - (x*Dx + 2)*(x*Dx -4), 0]],
145: [1, 0], [x,y]):
146:
147: sm1_res_solv([x,1],1,"x"):
148: sm1_res_solv([x,y],y,"x,y"):
149: */
150:
151: def sm1_res_solv_h(A,B,C) {
152: local P;
153: P = [[A,B], C];
154: sm1(P," res*solv*h /FunctionValue set ");
155: }
156:
157: def Reparse(A) {
158: if (IsArray(A)) {
159: return(Map(A,"Reparse"));
160: }else if (IsPolynomial(A) || IsInteger(A)) {
161: return(Poly(ToString(A)));
162: }else{
163: return(A);
164: }
165: }
166:
167: def sm1_res_sub2Q(I,V) {
168: local L,P;
169: L = Length(Arglist);
170: if (L == 1) {
171: P = I;
172: }else if ( L == 2) {
173: V = sm1_v_string(V);
174: if (IsArray(V)) {
175: sm1(V," from_records /V set ");
176: }
177: Weyl(V);
178: P = Reparse(I);
179: }
180: sm1(P," res-sub2Q /FunctionValue set ");
181: }
182:
183: /*
184: sm1_res_sub2Q([x*Dx,Dy]):
185: M res-sub2Q =: J, M \simeq D^p/J
186: */
187:
188: def ex2_9() {
189: Weyl("x,y,z");
190: I = [ x*Dx+y*Dy+z*Dz+6,
191: z^2*Dy-y^2*Dz,
192: z^2*Dx-x^2*Dz,
193: y^2*Dx-x^2*Dy,
194: x^3*Dz+y^3*Dz+z^3*Dz+6*z^2,
195: x^3*Dy+y^3*Dy+y^2*z*Dz+6*y^2];
196: a = sm1_resol1(I,"x,y,z");
197: return(a);
198: }
199:
1.2 takayama 200: def to_int0(A) {
201: local i,c,n,r;
202: if (IsArray(A)) {
203: n = Length(A);
204: r = NewArray(n);
205: for (i=0; i<n; i++) {
206: r[i] = to_int0(A[i]);
207: }
208: return(r);
209: } else if (IsInteger(A)) {
210: return(IntegerToSm1Integer(A));
211: } else {
212: return(A);
213: }
214: }
215: HelpAdd(["Translate.to_int0",
216: ["to_int0(a) : as same as sm1_push_int0."]]);
217:
218:
219: def GKZ(A,B) {
220: /* we need sm1_rat_to_p in a future. */
221: local c;
222: c = to_int0([A,B]);
223: sm1(c," gkz /FunctionValue set ");
224: }
225: HelpAdd(["GKZ.GKZ",
226: ["GKZ(a,b) returns the GKZ systems associated to the matrix a and the vector b",
227: "The answer is given by strings.",
1.4 ! takayama 228: "Example: GKZ([[1,1,1,1],[0,1,3,4]],[0,2]);"]]);
1.3 takayama 229:
230: def ToricIdeal(A) {
231: /* we need sm1_rat_to_p in a future. */
232: local c,B,i,n,pp;
233: n = Length(A);
234: B = NewArray(n);
235: for (i=0; i<n; i++) {B[i] = 0;}
236: c = to_int0([A,B]);
237: sm1(c," gkz 0 get /pp set ");
238: for (i=0; i<n; i++) { pp = Rest(pp); }
239: return(pp);
240: }
241: HelpAdd(["ToricIdeal",
242: ["ToricIdeal(a) returns the affine toric ideal associated to the matrix a",
243: "The answer is given by a list of strings.",
1.4 ! takayama 244: "Example: ToricIdeal([[1,1,1,1],[0,1,3,4]]);"]]);
1.2 takayama 245:
246: def Rest(a) {
247: sm1(a," rest /FunctionValue set ");
248: }
249: HelpAdd(["Rest",
250: ["Rest(a), list a; "]]);
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