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

Diff for /OpenXM/src/k097/slib.k between version 1.4 and 1.11

version 1.4, 2000/12/10 03:12:19 version 1.11, 2003/11/20 09:20:36
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/k097/slib.k,v 1.3 2000/12/10 02:21:46 takayama Exp $ */  /* $OpenXM: OpenXM/src/k097/slib.k,v 1.10 2001/01/13 01:17:36 takayama Exp $ */
 /*  slib.sm1, standard library. */  /*  slib.sm1, standard library. */
 /* April 26-- , 1996 */  /* April 26-- , 1996 */
 /* Don't use function names that is already used as a postscipt macro names*/  /* Don't use function names that is already used as a postscipt macro names*/
Line 8 
Line 8 
 if (K00_verbose)  if (K00_verbose)
  sm1(" ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message ");   sm1(" ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message ");
   
   
   /*
     Each Helplist[i] has the format
      [ category, [ key, explanations, ( args ,) (refs ,) (short descriptions)]]
        category : null or string
        key      : string
        explanations : string or array of string   (Ex. and << >> are key words)
        args     : null or list of strings
        refs     : null or list of strings
        short descriptions : string
   */
 Helplist = [ ];  Helplist = [ ];
 def void HelpAdd(s) {  def void HelpAdd(s,category) {
     local n;
     n = Length(Arglist);
     if (n <= 1) {
       category = null;
     }
     if (true) {
       /* Assert the args */
       /* You can use functions only defined before using HelpAdd */
       if (!(n == 1 || n == 2)) {
         Println(s);
         Error("HelpAdd: wrong argument length.");
       }
       if (!(Tag(category) == 0 || Tag(category) == 5)) {
         Println(category);
         Error("HelpAdd: wrong category.");
       }
       if (!(Tag(s) == 6)) {
         Println(s);
         Error("HelpAdd: s must be an array.");
       }
       if (! (Tag(s[0]) == 5)) {
         Println(s);
         Error("HelpAdd: s[0] must be a string.");
       }
       if (! (Tag(s[1]) == 5 || Tag(s[1]) == 6)) {
         Println(s);
         Error("HelpAdd: s[1] must be a string or an array.");
       }
       /* End of assert */
     }
     s = [category,s];
   Helplist = Append(Helplist,s);    Helplist = Append(Helplist,s);
 }  }
   
   def Tag(f) {
     local ans;
     ans = sm1(f," etag (universalNumber) dc ");
     return(ans);
   }
   def Error(s) {
     sm1(" s error ");
   }
   
 def Print(a) {                      /* print object without new line */  def Print(a) {                      /* print object without new line */
   sm1(a," messagen");    sm1(a," messagen");
 }  }
Line 37  def Append(f,g) { return(Join(f,[g])); }
Line 88  def Append(f,g) { return(Join(f,[g])); }
   
 def Length(f) { sm1(f," length (universalNumber) dc /FunctionValue set"); }  def Length(f) { sm1(f," length (universalNumber) dc /FunctionValue set"); }
   
 def Indexed(name,i) {  
   sm1(name,i," s.Indexed /FunctionValue set ");  
 }  
 /* Indexed2("a",2,3) ---> "a[2,3]" */  
 def Indexed2(name,i,j) {  
   sm1(name,i,j," s.Indexed2 /FunctionValue set ");  
 }  
 def Transpose(mat) {  def Transpose(mat) {
   sm1(mat," transpose /FunctionValue set ");    sm1(mat," transpose /FunctionValue set ");
 }  }
Line 78  def LiftStd(F) { /* Print("Input is "); Println(F); */
Line 122  def LiftStd(F) { /* Print("Input is "); Println(F); */
                             [arg1 [(needBack)]] groebner                              [arg1 [(needBack)]] groebner
                             /FunctionValue set "); }                              /FunctionValue set "); }
   
   /*
 def Reduction(f,G) {  def Reduction(f,G) {
   sm1(f,G," reduction /FunctionValue set ");    sm1(f,G," reduction /FunctionValue set ");
 }  }
   */
   def Reduction(f,myset) {
     local n, indexTable, set2, i, j, tmp, t_syz,r,rng,
           vsize,tt;
     vsize = null;
     r = GetRing(Poly("1"));  /* Save the current ring */
     rng = GetRing(f);
     if (Tag(rng) == 0) {
       rng = GetRing(myset);
     }
     if (Tag(rng) != 0) {SetRing(rng);}
   
     if (IsArray(f)) {
        vsize = Length(f);
        sm1(" [f] fromVectors 0 get /f set ");
     }
   
     n = Length(myset);
     if (n > 0) {
       if (IsArray(myset[0])) {
         if (vsize != Length(myset[0])) {
            Error("Reduction: size mismatch.");
         }
         sm1(" myset fromVectors /myset set ");
       }
     }
   
     indexTable = NewArray(n);
     set2 = [ ];
     j = 0;
     for (i=0; i<n; i++) {
       if (Tag(myset[i]) == 0) {
         indexTable[i] = -1;
       }else if (myset[i] == Poly("0")) {
         indexTable[i] = -1;
       }else{
         set2 = Append(set2,myset[i]);
         indexTable[i] = j;
         j++;
       }
     }
     sm1(" f set2 (gradedPolySet) dc reduction /tmp set ");
     t_syz = NewArray(n);
     for (i=0; i<n; i++) {
       if (indexTable[i] != -1) {
         t_syz[i] = tmp[2, indexTable[i]];
       }else{
         t_syz[i] = Poly("0");
       }
     }
     if (Tag(vsize) != 0) {
       tt = tmp[0];
       sm1(" [vsize (integer) dc tt] toVectors /tt set ");
       tmp[0] = tt;
     }
     SetRing(r);
     return([tmp[0],tmp[1],t_syz]);
   }
   
   
   
 def IntegerToSm1Integer(f) {  def IntegerToSm1Integer(f) {
   sm1(f, " (integer) dc /FunctionValue set ");    sm1(f, " (integer) dc /FunctionValue set ");
 }  }
 def RingD(vList,weightMatrix,pp) {  def RingD(vList,weightMatrix,pp) {
   local new0,tmp,size,n,i,j,newtmp,ringpp,argsize;    local new0,tmp,size,n,i,j,newtmp,ringpp,argsize;
   argsize = Length(Arglist);    argsize = Length(Arglist);
     if (IsArray(vList)) {
       sm1(" vList {toString} map from_records /vList set ");
     }
   if (argsize == 1) {    if (argsize == 1) {
     sm1("[", vList,      sm1("[", vList,
         "ring_of_differential_operators ( ) elimination_order 0 ] define_ring          "ring_of_differential_operators ( ) elimination_order 0 ] define_ring
          /tmp set ");           /tmp set ");
       SetRingVariables();
     return(tmp);      return(tmp);
   } else ;    } else ;
   if (argsize == 2) {    if (argsize == 2) {
Line 117  def RingD(vList,weightMatrix,pp) {
Line 224  def RingD(vList,weightMatrix,pp) {
   ringpp =    ringpp =
   sm1("[", vList,    sm1("[", vList,
       "ring_of_differential_operators ", new0, " weight_vector",pp, " ] define_ring");        "ring_of_differential_operators ", new0, " weight_vector",pp, " ] define_ring");
   /* setRingVariables();  It doesn't work. It's a mystery. */    SetRingVariables();
   sm1(" @@@.indexMode.flag.save @@@.indexMode ");    sm1(" @@@.indexMode.flag.save @@@.indexMode ");
   return( ringpp );    return( ringpp );
 }  }
Line 144  def getvarn() {
Line 251  def getvarn() {
   sm1( "[(N)] system_variable (universalNumber) dc /FunctionValue set ");    sm1( "[(N)] system_variable (universalNumber) dc /FunctionValue set ");
 }  }
   
 SetRingVariables_Verbose = true;  SetRingVariables_Verbose = false;
 def SetRingVariables() {  def SetRingVariables() {
   /* Don't use local variables in this function,    /* Don't use local variables in this function,
      because we set global variables in this function.       because we set global variables in this function.
Line 152  def SetRingVariables() {
Line 259  def SetRingVariables() {
   if (SetRingVariables_Verbose ) {    if (SetRingVariables_Verbose ) {
     Print("SetRingVariables() Setting the global variables : ");      Print("SetRingVariables() Setting the global variables : ");
   }    }
   k00setRingVariables(0,sm1( "[(CC)] system_variable (universalNumber) dc "));    if (k00setRingVariables(0,sm1( "[(N)] system_variable (universalNumber) dc "))) {
   k00setRingVariables(sm1( "[(C)] system_variable (universalNumber) dc "),      sm1(" define_ring_variables ");
                       sm1( "[(LL)] system_variable (universalNumber) dc "));    }
   k00setRingVariables(sm1( "[(L)] system_variable (universalNumber) dc "),  
                       sm1( "[(MM)] system_variable (universalNumber) dc "));  
   k00setRingVariables(sm1( "[(M)] system_variable (universalNumber) dc "),  
                       sm1( "[(NN)] system_variable (universalNumber) dc "));  
   if (SetRingVariables_Verbose) {Ln();}    if (SetRingVariables_Verbose) {Ln();}
 }  }
   
 def k00AreThereLeftBrace(s) {  def k00AreThereLeftBrace(s) {
   local leftBrace, jj, slist;    local leftBrace, jj, slist;
   leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc ");    leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc ");
   jj = Position(StringToIntegerArray(s),leftBrace);    jj = Position(StringToAsciiArray(s),leftBrace);
   if (jj != -1) return(true); else return(false);    if (jj != -1) return(true); else return(false);
 }  }
   
 def void k00setRingVariables(tmp002_p,tmp002_q) {  def k00setRingVariables(p,q) {
   /* tmp002_ must not be used as variables names. */    local v,i;
   local tmp002_i,tmp002_v,tmp002_str;    for (i = p; i< q; i++) {
   PSfor (tmp002_i=tmp002_p;tmp002_i<tmp002_q;tmp002_i++) {      v = getxvar(i);
     tmp002_v = getxvar(tmp002_i);      if (k00AreThereLeftBrace(v)) {
     if (k00AreThereLeftBrace(tmp002_v)) { ; }         return(false);
     else {  
       if (SetRingVariables_Verbose) {Print(tmp002_v); Print(" ");}  
       str = AddString(["/",tmp002_v," $",tmp002_v,"$ (poly) data_conversion def "]);  
       sm1("[(parse) ",str," ] extension ");  
     }      }
     tmp002_v = getdvar(tmp002_i);          v = getdvar(i);
     if (k00AreThereLeftBrace(tmp002_v)) { ; }      if (k00AreThereLeftBrace(v)) {
     else {         return(false);
       if (SetRingVariables_Verbose) {Print(tmp002_v); Print(" ");}  
       str = AddString(["/",tmp002_v," $",tmp002_v,"$ (poly) data_conversion def "]);  
       sm1("[(parse) ",str," ] extension ");  
     }      }
   }    }
     return(true);
 }  }
 /* ---------------------------------- */  /* ---------------------------------- */
   
Line 274  def Replace(f,rule) {
Line 371  def Replace(f,rule) {
 def Map(karg,func) {  def Map(karg,func) {
   sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set");    sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set");
 }  }
 HelpAdd(["Map",  
  ["Map(karg,func) applies the function <<func>> to the <<karg>>(string func).",  
   " Ex. Map([82,83,85],\"AsciiToString\"):"]]);  
 /* test Map  /* test Map
 def foo1(i) { return(i*2); }  def foo1(i) { return(i*2); }
 def foo() {  def foo() {
Line 297  def Position(list,elem) {
Line 391  def Position(list,elem) {
   sm1(" /k00.label0 ");    sm1(" /k00.label0 ");
   return(pos);    return(pos);
 }  }
 HelpAdd(["Position",  
  ["Position(list,elem) returns the position p of the element <<elem>> in",  
   " the array <<list>>. If <<elem>> is not in <<list>>, it return -1",  
   " (array list).",  
   "Ex. Position([1,34,2],34): "]]);  
   
 def StringToIntegerArray(s) {  def StringToAsciiArray(s) {
   sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set ");    sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set ");
 }  }
 HelpAdd(["StringToIntegerArray",  
  ["StringToIntegerArray(s) decomposes the string <<s>> into an array of",  
   "ascii codes of <<s>>  (string s).",  
   "cf. AsciiToString."]]);  
 def StringToAsciiArray(s) { return(StringToIntegerArray(s)); }  
 HelpAdd(["StringToAsciiArray",  
  ["StringToAsciiArray(s) is StringToIntegerArray(s)."]]);  
   
   
 def NewArray(n) {  def NewArray(n) {
  return(NewVector(n));   return(NewVector(n));
 }  }
 HelpAdd(["NewArray",  
 ["NewArray(n) returns an array of size n (integer n)."]]);  
   
 def GetEnv(s) {  def GetEnv(s) {
  sm1(" [(getenv) s] extension /FunctionValue set ");   sm1(" [(getenv) s] extension /FunctionValue set ");
 }  }
 HelpAdd(["GetEnv",  
 ["GetEnv(s) returns the value of the environmental variable s (string s)."]]);  
 def Boundp(a) {  def Boundp(a) {
    local b;     local b;
    sm1("[(parse) [(/) ",a," ( load tag 0 eq     sm1("[(parse) [(/) ",a," ( load tag 0 eq
                           { /FunctionValue 0 def }                            { /FunctionValue 0 def }
                           { /FunctionValue 1 def } ifelse )] cat ] extension");                            { /FunctionValue 1 def } ifelse )] cat ] extension");
 }  }
 HelpAdd(["Boundp",  
 ["Boundp(s) checks if the symbol s is bounded to a value or not (string s)."]]);  
 def Rest(a) {  def Rest(a) {
   sm1(a," rest /FunctionValue set ");    sm1(a," rest /FunctionValue set ");
 }  }
 HelpAdd(["Rest",  
 ["Rest(a) returns the rest (cdr) of  a (list a)."]]);  
 def GetPathName(s) {  def GetPathName(s) {
   local t,sss;    local t,sss;
   sss = s;    sss = s;
Line 355  def GetPathName(s) {
Line 428  def GetPathName(s) {
     return(s);      return(s);
   }    }
 }  }
 HelpAdd(["GetPathName",  
 ["GetPathName(s) checks if the file s exists in the current directory or",  
  "in LOAD_K_PATH. If there exists, it returns the path name (string s)."]]);  
   
   def Load_sm1(fnames,flag) {
     local ppp,n,i,cmd;
     if (Boundp(flag)) {
     }else{
       n = Length(fnames);
       for (i=0; i<n; i++) {
          ppp = GetPathName(fnames[i]);
          if (Tag(ppp) != 0) {
             sm1(" [(parse) ppp pushfile ] extension ");
             cmd = AddString(["/",flag," 1 def "]);
             sm1(" [(parse) cmd ] extension ");
             i=n; /* break; */
          }
       }
     }
   }
   
   
   def GetRing(f) {
     sm1(" f getRing /FunctionValue set ");
   }
   
   def SetRing(r) {
     sm1(" r ring_def ");
   }
   
   def ReParse(a) {
     local c;
     if (IsArray(a)) {
       c = Map(a,"ReParse");
     }else{
       sm1(a," toString . /c set");
     }
     return(c);
   }
   
   def void Pmat(a) {
      sm1(" a pmat ");
   }
   
   def void QuoteMode(a) {
     if ( a == 0) {
       sm1("[(QuoteMode) 0] system_variable ");
     }else{
       sm1("[(QuoteMode) 1] system_variable ");
     }
   }
   
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.11
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>