Annotation of OpenXM/src/k097/slib.k, Revision 1.7
1.7 ! takayama 1: /* $OpenXM: OpenXM/src/k097/slib.k,v 1.6 2000/12/28 00:08:13 takayama Exp $ */
1.1 maekawa 2: /* slib.sm1, standard library. */
3: /* April 26-- , 1996 */
4: /* Don't use function names that is already used as a postscipt macro names*/
5: /* You may encounter operand stack overflow. */
6: /* sm1("(incmac.sm1) run (slib.sm1) run ");
7: */
8: if (K00_verbose)
9: sm1(" ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message ");
10:
11: Helplist = [ ];
12: def void HelpAdd(s) {
13: Helplist = Append(Helplist,s);
14: }
15:
16: def Print(a) { /* print object without new line */
17: sm1(a," messagen");
18: }
19: def Println(a) { /* print object with new line */
20: sm1(a," message");
21: }
22: def Ln() { sm1(" ( ) message"); } /* newline */
23: /* Warning!! When use sm1 as f = sm1(...), Never set /FunctionValue.
24: Example: f = sm1(" 1 1 add /FunctionValue set ") causes error.
25: */
26: def Poly(f) {
27: sm1(f," (poly) data_conversion /FunctionValue set");
28: }
29: def PolyR(f,r) { /* parse the polynomial in R */
30: sm1(f,r," ,, /FunctionValue set");
31: }
32: def Degree(f,v) {
33: sm1(f,v," degree (universalNumber) dc /FunctionValue set");
34: }
35:
36: def Append(f,g) { return(Join(f,[g])); }
37:
38: def Length(f) { sm1(f," length (universalNumber) dc /FunctionValue set"); }
39:
40: def Indexed(name,i) {
41: sm1(name,i," s.Indexed /FunctionValue set ");
42: }
43: /* Indexed2("a",2,3) ---> "a[2,3]" */
44: def Indexed2(name,i,j) {
45: sm1(name,i,j," s.Indexed2 /FunctionValue set ");
46: }
47: def Transpose(mat) {
48: sm1(mat," transpose /FunctionValue set ");
49: }
50:
51: sm1("
52: /s.Indexed {
53: (integer) dc /arg2 set
54: /arg1 set
55: arg1 ([) arg2 (dollar) dc (]) 4 cat_n
56: } def
57:
58: /s.Indexed2 {
59: (integer) dc /arg3 set
60: (integer) dc /arg2 set
61: /arg1 set
62: arg1 ([) arg2 (dollar) dc (,) arg3 (dollar) dc (]) 6 cat_n
63: } def
64: ");
65:
66: def Groebner(F) { /* Print("Input is "); Println(F); */
67: sm1(F," {[[(h). (1).]] replace homogenize} map /arg1 set
68: [arg1] groebner 0 get
69: /FunctionValue set "); }
70:
71: def GroebnerTime(F) { /* Print("Input is "); Println(F); */
72: sm1(F," {[[(h). (1).]] replace homogenize} map /arg1 set
73: { [arg1] groebner 0 get } timer
74: /FunctionValue set "); }
75:
76: def LiftStd(F) { /* Print("Input is "); Println(F); */
77: sm1(F," {[[(h). (1).]] replace homogenize} map /arg1 set
78: [arg1 [(needBack)]] groebner
79: /FunctionValue set "); }
80:
1.7 ! takayama 81: /*
1.1 maekawa 82: def Reduction(f,G) {
83: sm1(f,G," reduction /FunctionValue set ");
1.7 ! takayama 84: }
! 85: */
! 86: def Reduction(f,myset) {
! 87: local n, indexTable, set2, i, j, tmp, t_syz,r,rng,
! 88: vsize,tt;
! 89: vsize = null;
! 90: r = GetRing(Poly("1")); /* Save the current ring */
! 91: rng = GetRing(f);
! 92: if (Tag(rng) == 0) {
! 93: rng = GetRing(myset);
! 94: }
! 95: if (Tag(rng) != 0) {SetRing(rng);}
! 96:
! 97: if (IsArray(f)) {
! 98: vsize = Length(f);
! 99: sm1(" [f] fromVectors 0 get /f set ");
! 100: }
! 101:
! 102: n = Length(myset);
! 103: if (n > 0) {
! 104: if (IsArray(myset[0])) {
! 105: if (vsize != Length(myset[0])) {
! 106: Error("Reduction: size mismatch.");
! 107: }
! 108: sm1(" myset fromVectors /myset set ");
! 109: }
! 110: }
! 111:
! 112: indexTable = NewArray(n);
! 113: set2 = [ ];
! 114: j = 0;
! 115: for (i=0; i<n; i++) {
! 116: if (Tag(myset[i]) == 0) {
! 117: indexTable[i] = -1;
! 118: }else if (myset[i] == Poly("0")) {
! 119: indexTable[i] = -1;
! 120: }else{
! 121: set2 = Append(set2,myset[i]);
! 122: indexTable[i] = j;
! 123: j++;
! 124: }
! 125: }
! 126: sm1(" f set2 (gradedPolySet) dc reduction /tmp set ");
! 127: t_syz = NewArray(n);
! 128: for (i=0; i<n; i++) {
! 129: if (indexTable[i] != -1) {
! 130: t_syz[i] = tmp[2, indexTable[i]];
! 131: }else{
! 132: t_syz[i] = Poly("0");
! 133: }
! 134: }
! 135: if (Tag(vsize) != 0) {
! 136: tt = tmp[0];
! 137: sm1(" [vsize (integer) dc tt] toVectors /tt set ");
! 138: tmp[0] = tt;
! 139: }
! 140: SetRing(r);
! 141: return([tmp[0],tmp[1],t_syz]);
1.1 maekawa 142: }
143:
144:
145:
146: def IntegerToSm1Integer(f) {
147: sm1(f, " (integer) dc /FunctionValue set ");
148: }
149: def RingD(vList,weightMatrix,pp) {
150: local new0,tmp,size,n,i,j,newtmp,ringpp,argsize;
151: argsize = Length(Arglist);
152: if (argsize == 1) {
153: sm1("[", vList,
154: "ring_of_differential_operators ( ) elimination_order 0 ] define_ring
155: /tmp set ");
1.5 takayama 156: SetRingVariables();
1.1 maekawa 157: return(tmp);
158: } else ;
159: if (argsize == 2) {
160: pp = 0;
161: }
162: pp = IntegerToSm1Integer(pp);
163: size = Length(weightMatrix);
164: new0 = NewVector(size);
165: sm1(" /@@@.indexMode.flag.save @@@.indexMode.flag def ");
166: sm1(" 0 @@@.indexMode ");
167: PSfor (i=0; i<size; i++) {
168: tmp = weightMatrix[i];
169: n = Length(tmp);
170: newtmp = NewVector(n);
171: for (j=1; j<n; j = j+2) {
172: newtmp[j-1] = tmp[j-1];
173: newtmp[j] = IntegerToSm1Integer( tmp[j] );
174: }
175: new0[i] = newtmp;
176: }
177: ringpp =
178: sm1("[", vList,
179: "ring_of_differential_operators ", new0, " weight_vector",pp, " ] define_ring");
1.5 takayama 180: SetRingVariables();
1.1 maekawa 181: sm1(" @@@.indexMode.flag.save @@@.indexMode ");
182: return( ringpp );
183: }
184:
185: /* RingD("x,y",[["x",2,"y",1]]);
186: RingD("x,y");
187: */
188:
189:
190:
191: /* from lib/setvariables.ccc : to generate sm1-package setvariables.sm1 */
192: /* 1997, 3/6 */
193: /* sm1(" 0 @@@.indexMode "); C-like notation of matrix. a[0], ... */
194:
195: def getxvar(i) {
196: sm1( "[(x) (var) ", i , " ..int ] system_variable /FunctionValue set ");
197: }
198:
199: def getdvar(i) {
200: sm1( "[(D) (var) ", i , " ..int ] system_variable /FunctionValue set ");
201: }
202:
203: def getvarn() {
204: sm1( "[(N)] system_variable (universalNumber) dc /FunctionValue set ");
205: }
206:
1.5 takayama 207: SetRingVariables_Verbose = false;
1.1 maekawa 208: def SetRingVariables() {
209: /* Don't use local variables in this function,
210: because we set global variables in this function.
211: cf. SSWork/yacc/memo.txt, 1997,3/6 */
212: if (SetRingVariables_Verbose ) {
213: Print("SetRingVariables() Setting the global variables : ");
214: }
1.5 takayama 215: if (k00setRingVariables(0,sm1( "[(N)] system_variable (universalNumber) dc "))) {
216: sm1(" define_ring_variables ");
217: }
1.1 maekawa 218: if (SetRingVariables_Verbose) {Ln();}
219: }
220:
221: def k00AreThereLeftBrace(s) {
222: local leftBrace, jj, slist;
223: leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc ");
224: jj = Position(StringToIntegerArray(s),leftBrace);
225: if (jj != -1) return(true); else return(false);
226: }
227:
1.5 takayama 228: def k00setRingVariables(p,q) {
229: local v,i;
230: for (i = p; i< q; i++) {
231: v = getxvar(i);
232: if (k00AreThereLeftBrace(v)) {
233: return(false);
1.1 maekawa 234: }
1.5 takayama 235: v = getdvar(i);
236: if (k00AreThereLeftBrace(v)) {
237: return(false);
1.1 maekawa 238: }
239: }
1.5 takayama 240: return(true);
1.1 maekawa 241: }
242: /* ---------------------------------- */
243:
244: def AddString(f) {
245: sm1(f," aload length cat_n /FunctionValue set ");
246: }
247:
248: def IntegerToString(f) {
249: sm1(f," (string) dc /FunctionValue set ");
250: }
251:
252: def Replace(f,rule) {
253: sm1(f,rule," replace /FunctionValue set ");
254: }
255:
256: def AsciiToString(c) {
257: sm1(c," (integer) dc (string) dc /FunctionValue set ");
258: }
259:
260:
261: /* From lib/tostr.ccc */
262: def ToString(p) {
263: local n,ans,i;
264: ans = [ ];
265: if (IsArray(p)) {
266: n = Length(p);
267: ans = Append(ans,"[ ");
268: for (i=0; i<n; i++) {
269: ans = Append(ans,ToString(p[i]));
270: if (i != n-1) {
271: ans = Append(ans," , ");
272: }
273: }
274: ans = Append(ans," ] ");
275: } else {
276: ans = [ sm1(p," (dollar) dc ") ];
277: /* Println(ans); */
278: }
279: return(AddString(ans));
280: }
281:
282: def IsArray(p) {
283: sm1(p," isArray /FunctionValue set ");
284: }
285:
286:
287: /* Println(tostr2([1,[2,3,4]])); */
288:
289:
290: def Denominator(f) {
291: sm1(f," (denominator) dc /FunctionValue set ");
292: }
293:
294: def Numerator(f) {
295: sm1(f," (numerator) dc /FunctionValue set ");
296: }
297:
298:
299: def Replace(f,rule) {
300: local ans,n,tmp,i,num,den;
301: if (IsArray(f)) {
302: n = Length(f);
303: ans = [ ];
304: for (i=0; i<n; i++) {
305: ans = Append(ans, Replace(f[i],rule));
306: }
307: return(ans);
308: }
309:
310: if (sm1(f," tag RationalFunctionP eq ")) {
311: num = Numerator(f);
312: den = Denominator(f);
313: num = sm1(num,rule, " replace ");
314: den = sm1(den,rule, " replace ");
315: return( num/den );
316: }
317:
318: sm1( f, rule , " replace /FunctionValue set ");
319: }
320:
321:
322:
323: /* 1997, 3/7 */
324: def Map(karg,func) {
325: sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set");
326: }
327: HelpAdd(["Map",
328: ["Map(karg,func) applies the function <<func>> to the <<karg>>(string func).",
329: " Ex. Map([82,83,85],\"AsciiToString\"):"]]);
330: /* test Map
331: def foo1(i) { return(i*2); }
332: def foo() {
333: Println(Map([82,83,84],"foo1"));
334: }
335: */
336:
337: def Position(list,elem) {
338: local n,pos,i;
339: n = Length(list);
340: pos = -1;
341: for (i=0; i<n; i++) {
342: if (elem == list[i]) {
343: pos = i;
344: sm1(" /k00.label0 goto ");
345: }
346: }
347: sm1(" /k00.label0 ");
348: return(pos);
349: }
350: HelpAdd(["Position",
351: ["Position(list,elem) returns the position p of the element <<elem>> in",
352: " the array <<list>>. If <<elem>> is not in <<list>>, it return -1",
353: " (array list).",
354: "Ex. Position([1,34,2],34): "]]);
355:
356: def StringToIntegerArray(s) {
357: sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set ");
358: }
359: HelpAdd(["StringToIntegerArray",
360: ["StringToIntegerArray(s) decomposes the string <<s>> into an array of",
361: "ascii codes of <<s>> (string s).",
362: "cf. AsciiToString."]]);
363: def StringToAsciiArray(s) { return(StringToIntegerArray(s)); }
364: HelpAdd(["StringToAsciiArray",
365: ["StringToAsciiArray(s) is StringToIntegerArray(s)."]]);
366:
367:
368: def NewArray(n) {
369: return(NewVector(n));
370: }
371: HelpAdd(["NewArray",
372: ["NewArray(n) returns an array of size n (integer n)."]]);
373:
1.3 takayama 374: def GetEnv(s) {
375: sm1(" [(getenv) s] extension /FunctionValue set ");
376: }
377: HelpAdd(["GetEnv",
378: ["GetEnv(s) returns the value of the environmental variable s (string s)."]]);
1.4 takayama 379: def Boundp(a) {
380: local b;
381: sm1("[(parse) [(/) ",a," ( load tag 0 eq
382: { /FunctionValue 0 def }
383: { /FunctionValue 1 def } ifelse )] cat ] extension");
384: }
385: HelpAdd(["Boundp",
386: ["Boundp(s) checks if the symbol s is bounded to a value or not (string s)."]]);
387: def Rest(a) {
388: sm1(a," rest /FunctionValue set ");
389: }
390: HelpAdd(["Rest",
391: ["Rest(a) returns the rest (cdr) of a (list a)."]]);
392: def GetPathName(s) {
393: local t,sss;
394: sss = s;
395: sm1(" [(stat) s] extension 0 get /t set ");
396: if (Tag(t) == 0) {
397: s=AddString([GetEnv("LOAD_K_PATH"),"/",s]);
398: sm1(" [(stat) s] extension 0 get /t set ");
399: if (Tag(t) == 0) {
400: return(null);
401: }else{
402: return(s);
403: }
404: }else{
405: return(s);
406: }
407: }
408: HelpAdd(["GetPathName",
409: ["GetPathName(s) checks if the file s exists in the current directory or",
410: "in LOAD_K_PATH. If there exists, it returns the path name (string s)."]]);
411:
1.5 takayama 412: def Load_sm1(fnames,flag) {
413: local ppp,n,i,cmd;
414: if (Boundp(flag)) {
415: }else{
416: n = Length(fnames);
417: for (i=0; i<n; i++) {
418: ppp = GetPathName(fnames[i]);
419: if (Tag(ppp) != 0) {
420: sm1(" [(parse) ppp pushfile ] extension ");
421: cmd = AddString(["/",flag," 1 def "]);
422: sm1(" [(parse) cmd ] extension ");
423: i=n; /* break; */
424: }
425: }
426: }
427: }
428:
429: HelpAdd(["Load_sm1",
430: ["Load_sm1(s,flag) loads a sm1 program from s[0], s[1], ....",
431: "If loading is succeeded, the already-loaded flag is set to true.",
432: "(list s, string flag)."]]);
1.6 takayama 433:
434: def GetRing(f) {
435: sm1(" f getRing /FunctionValue set ");
436: }
437:
438: def SetRing(r) {
439: sm1(" r ring_def ");
440: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to slib.k CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097