[BACK]Return to slib.k CVS log [TXT][DIR] Up to [local] / OpenXM / src / k097

Annotation of OpenXM/src/k097/slib.k, Revision 1.4

1.4     ! takayama    1: /* $OpenXM: OpenXM/src/k097/slib.k,v 1.3 2000/12/10 02:21:46 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:
                     81: def Reduction(f,G) {
                     82:   sm1(f,G," reduction /FunctionValue set ");
                     83: }
                     84:
                     85:
                     86:
                     87: def IntegerToSm1Integer(f) {
                     88:   sm1(f, " (integer) dc /FunctionValue set ");
                     89: }
                     90: def RingD(vList,weightMatrix,pp) {
                     91:   local new0,tmp,size,n,i,j,newtmp,ringpp,argsize;
                     92:   argsize = Length(Arglist);
                     93:   if (argsize == 1) {
                     94:     sm1("[", vList,
                     95:         "ring_of_differential_operators ( ) elimination_order 0 ] define_ring
                     96:          /tmp set ");
                     97:     return(tmp);
                     98:   } else ;
                     99:   if (argsize == 2) {
                    100:     pp = 0;
                    101:   }
                    102:   pp = IntegerToSm1Integer(pp);
                    103:   size = Length(weightMatrix);
                    104:   new0 = NewVector(size);
                    105:   sm1(" /@@@.indexMode.flag.save @@@.indexMode.flag def ");
                    106:   sm1(" 0 @@@.indexMode ");
                    107:   PSfor (i=0; i<size; i++) {
                    108:     tmp = weightMatrix[i];
                    109:     n = Length(tmp);
                    110:     newtmp = NewVector(n);
                    111:     for (j=1; j<n; j = j+2) {
                    112:        newtmp[j-1] = tmp[j-1];
                    113:        newtmp[j] = IntegerToSm1Integer( tmp[j] );
                    114:     }
                    115:     new0[i] = newtmp;
                    116:   }
                    117:   ringpp =
                    118:   sm1("[", vList,
                    119:       "ring_of_differential_operators ", new0, " weight_vector",pp, " ] define_ring");
                    120:   /* setRingVariables();  It doesn't work. It's a mystery. */
                    121:   sm1(" @@@.indexMode.flag.save @@@.indexMode ");
                    122:   return( ringpp );
                    123: }
                    124:
                    125: /* RingD("x,y",[["x",2,"y",1]]);
                    126:    RingD("x,y");
                    127: */
                    128:
                    129:
                    130:
                    131: /* from lib/setvariables.ccc :  to generate sm1-package setvariables.sm1 */
                    132: /*  1997, 3/6 */
                    133: /* sm1(" 0 @@@.indexMode ");  C-like notation of matrix. a[0], ... */
                    134:
                    135: def getxvar(i) {
                    136:   sm1( "[(x) (var) ", i , " ..int ] system_variable /FunctionValue set ");
                    137: }
                    138:
                    139: def getdvar(i) {
                    140:   sm1( "[(D) (var) ", i , " ..int ] system_variable /FunctionValue set ");
                    141: }
                    142:
                    143: def getvarn() {
                    144:   sm1( "[(N)] system_variable (universalNumber) dc /FunctionValue set ");
                    145: }
                    146:
                    147: SetRingVariables_Verbose = true;
                    148: def SetRingVariables() {
                    149:   /* Don't use local variables in this function,
                    150:      because we set global variables in this function.
                    151:      cf. SSWork/yacc/memo.txt,  1997,3/6 */
                    152:   if (SetRingVariables_Verbose ) {
                    153:     Print("SetRingVariables() Setting the global variables : ");
                    154:   }
                    155:   k00setRingVariables(0,sm1( "[(CC)] system_variable (universalNumber) dc "));
                    156:   k00setRingVariables(sm1( "[(C)] system_variable (universalNumber) dc "),
                    157:                       sm1( "[(LL)] system_variable (universalNumber) dc "));
                    158:   k00setRingVariables(sm1( "[(L)] system_variable (universalNumber) dc "),
                    159:                       sm1( "[(MM)] system_variable (universalNumber) dc "));
                    160:   k00setRingVariables(sm1( "[(M)] system_variable (universalNumber) dc "),
                    161:                       sm1( "[(NN)] system_variable (universalNumber) dc "));
                    162:   if (SetRingVariables_Verbose) {Ln();}
                    163: }
                    164:
                    165: def k00AreThereLeftBrace(s) {
                    166:   local leftBrace, jj, slist;
                    167:   leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc ");
                    168:   jj = Position(StringToIntegerArray(s),leftBrace);
                    169:   if (jj != -1) return(true); else return(false);
                    170: }
                    171:
                    172: def void k00setRingVariables(tmp002_p,tmp002_q) {
                    173:   /* tmp002_ must not be used as variables names. */
                    174:   local tmp002_i,tmp002_v,tmp002_str;
                    175:   PSfor (tmp002_i=tmp002_p;tmp002_i<tmp002_q;tmp002_i++) {
                    176:     tmp002_v = getxvar(tmp002_i);
                    177:     if (k00AreThereLeftBrace(tmp002_v)) { ; }
                    178:     else {
                    179:       if (SetRingVariables_Verbose) {Print(tmp002_v); Print(" ");}
                    180:       str = AddString(["/",tmp002_v," $",tmp002_v,"$ (poly) data_conversion def "]);
                    181:       sm1("[(parse) ",str," ] extension ");
                    182:     }
                    183:     tmp002_v = getdvar(tmp002_i);
                    184:     if (k00AreThereLeftBrace(tmp002_v)) { ; }
                    185:     else {
                    186:       if (SetRingVariables_Verbose) {Print(tmp002_v); Print(" ");}
                    187:       str = AddString(["/",tmp002_v," $",tmp002_v,"$ (poly) data_conversion def "]);
                    188:       sm1("[(parse) ",str," ] extension ");
                    189:     }
                    190:   }
                    191: }
                    192: /* ---------------------------------- */
                    193:
                    194: def AddString(f) {
                    195:   sm1(f,"  aload length cat_n /FunctionValue set ");
                    196: }
                    197:
                    198: def IntegerToString(f) {
                    199:   sm1(f," (string) dc /FunctionValue set ");
                    200: }
                    201:
                    202: def Replace(f,rule) {
                    203:   sm1(f,rule," replace /FunctionValue set ");
                    204: }
                    205:
                    206: def AsciiToString(c) {
                    207:   sm1(c," (integer) dc (string) dc /FunctionValue set ");
                    208: }
                    209:
                    210:
                    211: /* From lib/tostr.ccc */
                    212: def ToString(p) {
                    213:   local n,ans,i;
                    214:   ans = [ ];
                    215:   if (IsArray(p)) {
                    216:     n = Length(p);
                    217:     ans = Append(ans,"[ ");
                    218:     for (i=0; i<n; i++) {
                    219:       ans = Append(ans,ToString(p[i]));
                    220:       if (i != n-1) {
                    221:         ans = Append(ans," , ");
                    222:       }
                    223:     }
                    224:     ans = Append(ans," ] ");
                    225:   } else {
                    226:     ans = [ sm1(p," (dollar) dc ") ];
                    227:     /* Println(ans);   */
                    228:   }
                    229:   return(AddString(ans));
                    230: }
                    231:
                    232: def IsArray(p) {
                    233:   sm1(p," isArray /FunctionValue set  ");
                    234: }
                    235:
                    236:
                    237: /* Println(tostr2([1,[2,3,4]])); */
                    238:
                    239:
                    240: def Denominator(f) {
                    241:   sm1(f," (denominator) dc /FunctionValue set ");
                    242: }
                    243:
                    244: def Numerator(f) {
                    245:   sm1(f," (numerator) dc /FunctionValue set ");
                    246: }
                    247:
                    248:
                    249: def Replace(f,rule) {
                    250:   local ans,n,tmp,i,num,den;
                    251:   if (IsArray(f)) {
                    252:     n = Length(f);
                    253:     ans = [ ];
                    254:     for (i=0; i<n; i++) {
                    255:       ans = Append(ans, Replace(f[i],rule));
                    256:     }
                    257:     return(ans);
                    258:   }
                    259:
                    260:   if (sm1(f," tag RationalFunctionP eq ")) {
                    261:      num = Numerator(f);
                    262:      den = Denominator(f);
                    263:      num = sm1(num,rule, " replace ");
                    264:      den = sm1(den,rule, " replace ");
                    265:      return( num/den );
                    266:   }
                    267:
                    268:   sm1( f, rule , " replace /FunctionValue set ");
                    269: }
                    270:
                    271:
                    272:
                    273: /* 1997, 3/7 */
                    274: def Map(karg,func) {
                    275:   sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set");
                    276: }
                    277: HelpAdd(["Map",
                    278:  ["Map(karg,func) applies the function <<func>> to the <<karg>>(string func).",
                    279:   " Ex. Map([82,83,85],\"AsciiToString\"):"]]);
                    280: /* test Map
                    281: def foo1(i) { return(i*2); }
                    282: def foo() {
                    283:   Println(Map([82,83,84],"foo1"));
                    284: }
                    285: */
                    286:
                    287: def Position(list,elem) {
                    288:   local n,pos,i;
                    289:   n = Length(list);
                    290:   pos = -1;
                    291:   for (i=0; i<n; i++) {
                    292:     if (elem == list[i]) {
                    293:       pos = i;
                    294:       sm1(" /k00.label0 goto ");
                    295:     }
                    296:   }
                    297:   sm1(" /k00.label0 ");
                    298:   return(pos);
                    299: }
                    300: HelpAdd(["Position",
                    301:  ["Position(list,elem) returns the position p of the element <<elem>> in",
                    302:   " the array <<list>>. If <<elem>> is not in <<list>>, it return -1",
                    303:   " (array list).",
                    304:   "Ex. Position([1,34,2],34): "]]);
                    305:
                    306: def StringToIntegerArray(s) {
                    307:   sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set ");
                    308: }
                    309: HelpAdd(["StringToIntegerArray",
                    310:  ["StringToIntegerArray(s) decomposes the string <<s>> into an array of",
                    311:   "ascii codes of <<s>>  (string s).",
                    312:   "cf. AsciiToString."]]);
                    313: def StringToAsciiArray(s) { return(StringToIntegerArray(s)); }
                    314: HelpAdd(["StringToAsciiArray",
                    315:  ["StringToAsciiArray(s) is StringToIntegerArray(s)."]]);
                    316:
                    317:
                    318: def NewArray(n) {
                    319:  return(NewVector(n));
                    320: }
                    321: HelpAdd(["NewArray",
                    322: ["NewArray(n) returns an array of size n (integer n)."]]);
                    323:
1.3       takayama  324: def GetEnv(s) {
                    325:  sm1(" [(getenv) s] extension /FunctionValue set ");
                    326: }
                    327: HelpAdd(["GetEnv",
                    328: ["GetEnv(s) returns the value of the environmental variable s (string s)."]]);
1.4     ! takayama  329: def Boundp(a) {
        !           330:    local b;
        !           331:    sm1("[(parse) [(/) ",a," ( load tag 0 eq
        !           332:                           { /FunctionValue 0 def }
        !           333:                           { /FunctionValue 1 def } ifelse )] cat ] extension");
        !           334: }
        !           335: HelpAdd(["Boundp",
        !           336: ["Boundp(s) checks if the symbol s is bounded to a value or not (string s)."]]);
        !           337: def Rest(a) {
        !           338:   sm1(a," rest /FunctionValue set ");
        !           339: }
        !           340: HelpAdd(["Rest",
        !           341: ["Rest(a) returns the rest (cdr) of  a (list a)."]]);
        !           342: def GetPathName(s) {
        !           343:   local t,sss;
        !           344:   sss = s;
        !           345:   sm1(" [(stat) s] extension 0 get /t set ");
        !           346:   if (Tag(t) == 0) {
        !           347:     s=AddString([GetEnv("LOAD_K_PATH"),"/",s]);
        !           348:     sm1(" [(stat) s] extension 0 get /t set ");
        !           349:     if (Tag(t) == 0) {
        !           350:       return(null);
        !           351:     }else{
        !           352:       return(s);
        !           353:     }
        !           354:   }else{
        !           355:     return(s);
        !           356:   }
        !           357: }
        !           358: HelpAdd(["GetPathName",
        !           359: ["GetPathName(s) checks if the file s exists in the current directory or",
        !           360:  "in LOAD_K_PATH. If there exists, it returns the path name (string s)."]]);
        !           361:

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>