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