Changeset 5dc4ea in git

Timestamp:

Sep 18, 1997, 11:58:26 AM (27 years ago)

Author:

Hans Schönemann <hannes@…>

Branches:

(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')

Children:

1a5daea04547872672e8d5c6d19ac391e34ca05e

Parents:

741512c3f18910d2025325eadcbef56647da00d0

Message:

* hannes: changes to naLcm, naNormalize
* greuel/hannes: changes to deform.lib invar.lib(Header) matrix.lib
     prim_dec.lib primdec.lib


git-svn-id: file:///usr/local/Singular/svn/trunk@730 2c84dea3-7e68-4137-9b89-c4e89433aadc

Location:

Singular

Files:

• LIB/deform.lib (modified) (4 diffs)
• LIB/invar.lib (modified) (1 diff)
• LIB/matrix.lib (modified) (3 diffs)
• LIB/prim_dec.lib (modified) (2 diffs)
• LIB/primdec.lib (modified) (2 diffs)
• longalg.cc (modified) (8 diffs)

Singular/LIB/deform.lib

@@ -1 @@
-// $Id: deform.lib,v 1.2 1997-04-28 19:27:15 obachman Exp $
+// $Id: deform.lib,v 1.3 1997-09-18 09:58:22 Singular Exp $
 //(BM/GMG, last modified 22.06.96)
 ///////////////////////////////////////////////////////////////////////////////
@@ -42 +42 @@
             ideal jetJ - defining the miniversal base space (in `na`)
             ideal jetF - defining miniversal total space (in `na`)
-NOTE:    printlevel >=0: display dimT1,T2 and explain created objects (default)
+NOTE:    printlevel >=0: display dimT1,T2 and miniversal equations (default)
          printlevel >=1: show partial + final result during computation
          printlevel >=2: show also memory and time usage
@@ -72 +72 @@
    id = simplify(id,10);
    int @rowR = size(id);
-   if( @rowR<=1 )
-   {
-      "// hypersurface, use proc deform from sing.lib";
-      return();
-   }
+   //if( @rowR<=1 )
+   //{
+   //   "// hypersurface, use proc deform from sing.lib";
+   //   return();
+   //}
 //------- change ordering if not correct --------------------------------------
    @t1=1;
@@ -221 +221 @@
    }
 //---------  end loop and final output ---------------------------------------
-dbprint(p-1,"","// ___ Equations of miniversal base space ___",jetJ,
-            "","// ___ Equations of miniversal total space ___",jetF);
-dbprint(p,"","// Result belongs to ring "+@na+".",
-       "// Equations of total space of miniversal deformation are ",
-       "// given by jetF, equations of miniversal base space by jetJ.",
+dbprint(p,"","// ___ Equations of miniversal base space (jetJ) ___",jetJ,
+          "","// ___ Equations of miniversal total space (jetF) ___",jetF);
+dbprint(p,"","// Equations of base space of miniversal deformation are given",
+       "// by the ideal jetJ, equations of miniversal total space by jetF.",
+       "// Both are defined in the ring "+@na+" created in 'miniversal'.",
        "// Make "+@na+" the basering and list objects defined in "+@na+" by typing:",
-       "   setring "+@na+"; show("+@na+");","   listvar(ideal);");
+       "// setring "+@na+";  show("+@na+");  listvar(ideal);");
   kill @On;
   return();

Singular/LIB/invar.lib

@@ -1 @@
-// $Id: invar.lib,v 1.2 1997-09-10 07:52:55 Singular Exp $
+// $Id: invar.lib,v 1.3 1997-09-18 09:58:24 Singular Exp $
 ///////////////////////////////////////////////////////
 // invar.lib
 // algorithm for computing the ring of invariants under
-// the action of the additive group
+// the action of the additive group (C,+)
 // written by Gerhard Pfister
 //////////////////////////////////////////////////////
 
-LIBRARY: invar.lib PROCEDURE FOR COMPUTING INVARIANTS UNDER C+-ACTIONS
+LIBRARY: invar.lib PROCEDURE FOR COMPUTING INVARIANTS UNDER (C,+)-ACTIONS
 
   invariantRing(matrix m,poly p,poly q,int choose)

Singular/LIB/matrix.lib

@@ -1 @@
-// $Id: matrix.lib,v 1.3 1997-08-12 14:01:08 Singular Exp $
+// $Id: matrix.lib,v 1.4 1997-09-18 09:58:24 Singular Exp $
 // (GMG/BM, last modified 22.06.96)
 ///////////////////////////////////////////////////////////////////////////////
@@ -12 +12 @@
  is_complex(c);         1 if list c is a complex, 0 if not
  outer(A,B);            matrix, outer product of matrices A and B
+ power(A,n);            matrix/intmat, n-th power of matrix/intmat A
  skewmat(n[,id]);       generic skew-symmetric nxn matrix [entries from id]
  submat(A,r,c);         submatrix of A with rows/cols specified by intvec r/c
@@ -265 +266 @@
 ////////////////////////////////////////////////////////////////////////////////
 
+proc power ( A, int n)
+USAGE:   power(A,n);  A a square-matrix of type intmat or matrix, n=integer
+RETURN:  inmat resp. matrix, the n-th power of A
+NOTE:    for intamt and big n the result may be wrong because of int overflow
+EXAMPLE: example power; shows an example
+{
+//---------------------------- type checking ----------------------------------
+   if( typeof(A)!="matrix" and typeof(A)!="intmat" )
+   {
+      "// no matrix or intmat!";
+      return (A);
+   }
+   if( ncols(A) != nrows(A) )
+   {
+      "// not a suare matrix!";
+      return();
+   }
+//---------------------------- trivial cases ----------------------------------
+   int ii;
+   if( n <= 0 ) 
+   {
+      if( typeof(A)=="matrix" ) 
+      { 
+         return (unitmat(nrows(A))); 
+      }
+      if( typeof(A)=="intmat" ) 
+      { 
+         intmat B[nrows(A)][nrows(A)];
+         for( ii=1; ii<=nrows(A); ii++ )
+         {
+            B[ii,ii] = 1;
+         }
+         return (B); 
+      }
+   }
+   if( n == 1 ) { return (A); }
+//---------------------------- sub procedure ----------------------------------
+   proc matpow (A, int n)
+   {
+      def B = A*A;
+      int ii= 2;
+      int jj= 4;
+      while( jj <= n )
+      {
+         B=B*B;
+         ii=jj;
+         jj=2*jj;
+      }
+      return(B,n-ii);
+   }
+//----------------------------- main program ----------------------------------
+   list L = matpow(A,n);
+   def B  = L[1];
+   ii     = L[2];
+   while( ii>=2 )
+   {
+      L = matpow(A,ii);
+      B = B*L[1];
+      ii= L[2];
+   }
+   if( ii == 0) { return(B); }
+   if( ii == 1) { return(A*B); }
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   intmat A[3][3]=1,2,3,4,5,6,7,8,9;
+   print(power(A,3));"";
+   ring r=0,(x,y,z),dp;
+   matrix B[4][4]=0,x,y,z,0,0,y,z,0,0,0,z,x,y,z,0;
+   print(power(B,3));"";
+   matrix C[3][3]=1,2,3,4,5,6,7,8,9;
+   power(C,50);
+}
+////////////////////////////////////////////////////////////////////////////////
+
 proc skewmat (int n, list #)
 USAGE:   skewmat(n[,id]);  n integer, id ideal

Singular/LIB/prim_dec.lib

@@ -1 @@
-// $Id: prim_dec.lib,v 1.5 1997-08-12 17:14:45 Singular Exp $
+// $Id: prim_dec.lib,v 1.6 1997-09-18 09:58:25 Singular Exp $
 ///////////////////////////////////////////////////////
 // pseudoprimdec.lib
@@ -7 +7 @@
 //////////////////////////////////////////////////////
 
-LIBRARY: prim_dec.lib: PROCEDURE FOR PRIMARY DECOMPOSITION (II)
+LIBRARY: prim_dec.lib: PROCEDURE FOR PRIMARY DECOMPOSITION (S/Y)
 
   min_ass_prim_charsets (ideal I, int choose)

Singular/LIB/primdec.lib

@@ -1 @@
-// $Id: primdec.lib,v 1.4 1997-09-10 10:55:39 Singular Exp $
+// $Id: primdec.lib,v 1.5 1997-09-18 09:58:26 Singular Exp $
 ///////////////////////////////////////////////////////
 // primdec.lib
@@ -7 +7 @@
 //////////////////////////////////////////////////////
 
-LIBRARY: primdec.lib: PROCEDURE FOR PRIMARY DECOMPOSITION (I)
+LIBRARY: primdec.lib: PROCEDURE FOR PRIMARY DECOMPOSITION (G/T/Z)
 
   minAssPrimes (ideal I, list choose)

Singular/longalg.cc

@@ -2 +2 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: longalg.cc,v 1.11 1997-09-16 13:45:32 Singular Exp $ */
+/* $Id: longalg.cc,v 1.12 1997-09-18 09:58:20 Singular Exp $ */
 /*
 * ABSTRACT:   algebraic numbers
@@ -54 +54 @@
 /* procedure variables */
 static numberfunc
-                nacMult, nacSub, nacAdd, nacDiv, nacGcd, nacLcm;
+                nacMult, nacSub, nacAdd, nacDiv, nacIntDiv, nacGcd, nacLcm;
 #ifdef LDEBUG
 static void     (*nacDBDelete)(number *a,char *f,int l);
@@ -79 +79 @@
 static int napExpi(int i, alg a, alg b);
 
+static number nadGcd( number a, number b) { return nacInit(1); }
 /*2
 *  sets the appropriate operators
@@ -114 +115 @@
       nacMult        = nlMult;
       nacDiv         = nlDiv;
+      nacIntDiv      = nlIntDiv;
       nacInvers      = nlInvers;
       nacNormalize   = nlNormalize;
@@ -145 +147 @@
       nacMult        = npMult;
       nacDiv         = npDiv;
+      nacIntDiv      = npDiv;
       nacInvers      = npInvers;
       nacNormalize   = nDummy2;
@@ -154 +157 @@
       nacIsOne       = npIsOne;
       nacIsMOne      = npIsMOne;
-      nacGcd         = ndGcd;
-      nacLcm         = ndGcd;
+      nacGcd         = nadGcd;
+      nacLcm         = nadGcd;
     }
   }
@@ -167 +170 @@
 
 /*============= procedure for polynomials: napXXXX =======================*/
+
+#define napSetCoeff(p,n) {nacDelete(&((p)->ko));(p)->ko=n;}
+#define napIter(A) A=(A)->ne
+
 
 /*3
@@ -2016 +2023 @@
   }
 #endif
+  /* remove common factors from z and n */
+  x=p->z;
+  y=p->n;
+  if(!nacGreaterZero(napGetCoeff(y)))
+  {
+    x=napNeg(x);
+    y=napNeg(y);
+  }
+  number g=nacCopy(napGetCoeff(x));
+  napIter(x);
+  while (x!=NULL)
+  {
+    number d=nacGcd(g,napGetCoeff(x));
+    if(nacIsOne(d))
+    {
+      nacDelete(&g);
+      nacDelete(&d);
+      return;
+    }
+    nacDelete(&g);
+    g = d;
+    napIter(x);
+  }
+  while (y!=NULL)
+  {
+    number d=nacGcd(g,napGetCoeff(y));
+    if(nacIsOne(d))
+    {
+      nacDelete(&g);
+      nacDelete(&d);
+      return;
+    }
+    nacDelete(&g);
+    g = d;
+    napIter(y);
+  }
+  x=p->z;
+  y=p->n;
+  while (x!=NULL)
+  {
+    number d = nacIntDiv(napGetCoeff(x),g);
+    napSetCoeff(x,d);
+    napIter(x);
+  }
+  while (y!=NULL)
+  {
+    number d = nacIntDiv(napGetCoeff(y),g);
+    napSetCoeff(y,d);
+    napIter(y);
+  }
+  nacDelete(&g);
 }