OpenXM/src/k097/slib.k - diff

Return to slib.k CVS log

Up to [local] / OpenXM / src / k097

Diff for /OpenXM/src/k097/slib.k between version 1.5 and 1.8

-version 1.5, 2000/12/10 09:34:27
+version 1.8, 2001/01/05 11:14:25
 Line 1
 Line 1
 Line 1
- /* $OpenXM: OpenXM/src/k097/slib.k,v 1.4 2000/12/10 03:12:19 takayama Exp $ */
+ /* $OpenXM: OpenXM/src/k097/slib.k,v 1.7 2001/01/04 12:29:31 takayama Exp $ */
  /*  slib.sm1, standard library. */
  /* April 26-- , 1996 */
  /* Don't use function names that is already used as a postscipt macro names*/
 Line 37  def Append(f,g) { return(Join(f,[g])); }
 Line 37  def Append(f,g) { return(Join(f,[g])); }
 Line 37  def Append(f,g) { return(Join(f,[g])); }
  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) {
    sm1(mat," transpose /FunctionValue set ");
  }
-Line 78  def LiftStd(F) { /* Print("Input is "); Println(F); */
+Line 71  def LiftStd(F) { /* Print("Input is "); Println(F); */
 Line 78  def LiftStd(F) { /* Print("Input is "); Println(F); */
 Line 71  def LiftStd(F) { /* Print("Input is "); Println(F); */
                              [arg1 [(needBack)]] groebner
                              /FunctionValue set "); }
+ /*
  def Reduction(f,G) {
    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) {
    sm1(f, " (integer) dc /FunctionValue set ");
  }
-Line 371  HelpAdd(["Load_sm1",
+Line 423  HelpAdd(["Load_sm1",
 Line 371  HelpAdd(["Load_sm1",
 Line 423  HelpAdd(["Load_sm1",
  ["Load_sm1(s,flag) loads a sm1 program from s[0], s[1], ....",
   "If loading is succeeded, the already-loaded flag is set to true.",
   "(list s, string flag)."]]);
+ 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);
+ }
+ HelpAdd(["ReParse",
+ ["Reparse(obj): ",
+  "It parses the given object in the current ring."
+ ]]);
+ def void Pmat(a) {
+    sm1(" a pmat ");
+ }
+ HelpAdd(["Pmat",
+ ["Pmat(m): ",
+  "Print the array m in a pretty way."
+ ]]);

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