Annotation of OpenXM/src/k097/slib.k, Revision 1.1
1.1 ! maekawa 1:
! 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:
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