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

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

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

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