Changeset d9ccb8 in git

Timestamp:

Jun 18, 2018, 4:33:19 PM (6 years ago)

Author:

Hans Schoenemann <hannes@…>

Branches:

(u'fieker-DuVal', '117eb8c30fc9e991c4decca4832b1d19036c4c65')(u'spielwiese', 'b4f17ed1d25f93d46dbe29e4b499baecc2fd51bb')

Children:

a6a875048bfb185f59dc11aa3f301173392ef1ea

Parents:

b1f3061bfc36e07816a066e0ae80a4f44ed566d4

Message:

add: tensor(smatrix,smatrix) as kernel cmd.

Location:

Singular

Files:

• LIB/matrix.lib (modified) (2 diffs)
• extra.cc (modified) (1 diff)
• iparith.cc (modified) (1 diff)
• table.h (modified) (5 diffs)
• tok.h (modified) (1 diff)

Singular/LIB/matrix.lib

@@ -18 +18 @@
  submat(A,r,c);         submatrix of A with rows/cols specified by intvec r/c
  symmat(n[,id]);        generic symmetric nxn matrix [entries from id]
- tensor(A,B);           matrix, tensor product of matrices A nd B
  unitmat(n);            unit square matrix of size n
  gauss_col(A);          transform a matrix into col-reduced Gauss normal form
@@ -457 +456 @@
    print(symmat(n,i));  // symmetric matrix of generic linear forms
    kill R1;
-}
-///////////////////////////////////////////////////////////////////////////////
-
-proc tensor (matrix A, matrix B)
-"USAGE:   tensor(A,B); A,B matrices
-RETURN:  matrix, tensor product of A and B
-EXAMPLE: example tensor; shows an example
-"
-{
-   if (ncols(A)==0)
-   {
-     int q=nrows(A)*nrows(B);
-     matrix D[q][0];
-     return(D);
-   }
-
-   int i,j;
-   matrix C,D;
-   for( i=1; i<=nrows(A); i++ )
-   {
-     C = A[i,1]*B;
-     for( j=2; j<=ncols(A); j++ )
-     {
-       C = concat(C,A[i,j]*B);
-     }
-     D = concat(D,transpose(C));
-   }
-   D = transpose(D);
-   return(submat(D,2..nrows(D),1..ncols(D)));
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring r=32003,(x,y,z),(c,ds);
-   matrix A[3][3]=1,2,3,4,5,6,7,8,9;
-   matrix B[2][2]=x,y,0,z;
-   print(A);
-   print(B);
-   print(tensor(A,B));
 }
 ///////////////////////////////////////////////////////////////////////////////

Singular/extra.cc

@@ -3773 +3773 @@
     }
     else
-/*==================== tensor =================*/
-    if(strcmp(sys_cmd,"tensor")==0)
-    {
-      const short t[]={2,MODUL_CMD,MODUL_CMD};
-      if (iiCheckTypes(h,t,1))
-      {
-        res->data=(void*)mp_Tensor((ideal)h->Data(),(ideal)h->next->Data(),currRing);
-        res->rtyp=MODUL_CMD;
-        return FALSE;
-      }
-      else
-        return TRUE;
-    }
-    else
 /*==================== GF(p,n) ==================================*/
     if(strcmp(sys_cmd,"GF")==0)

Singular/iparith.cc

@@ -3395 +3395 @@
   if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
   return FALSE;
-
+}
+static BOOLEAN jjTENSOR(leftv res, leftv u, leftv v)
+{
+  ideal A=(ideal)u->Data();
+  ideal B=(ideal)v->Data();
+  res->data = (char *)sm_Tensor(A,B,currRing);
+  return FALSE;
 }
 static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)

Singular/table.h

@@ -79 +79 @@
 //,{  jjWRONG ,       COLS_CMD,        0,              VECTOR_CMD  , ALLOW_NC |ALLOW_RING}
 ,{D(jjCOLS),       COLS_CMD,        INT_CMD,        MATRIX_CMD    , ALLOW_NC |ALLOW_RING}
+,{D(jjCOLS),       COLS_CMD,        INT_CMD,        SMATRIX_CMD   , ALLOW_NC |ALLOW_RING}
 ,{D(jjCOLS),       COLS_CMD,        INT_CMD,        IDEAL_CMD     , ALLOW_NC |ALLOW_RING}
 ,{D(jjCOLS),       COLS_CMD,        INT_CMD,        MODUL_CMD     , ALLOW_NC |ALLOW_RING}
@@ -253 +254 @@
 ,{D(jjROWS),       ROWS_CMD,        INT_CMD,        MODUL_CMD     , ALLOW_NC |ALLOW_RING}
 ,{D(jjROWS),       ROWS_CMD,        INT_CMD,        MATRIX_CMD    , ALLOW_NC |ALLOW_RING}
+,{D(jjROWS),       ROWS_CMD,        INT_CMD,        SMATRIX_CMD   , ALLOW_NC |ALLOW_RING}
 ,{D(jjROWS_IV),    ROWS_CMD,        INT_CMD,        INTMAT_CMD    , ALLOW_NC |ALLOW_RING}
 ,{D(jjROWS_BIM),   ROWS_CMD,        INT_CMD,        BIGINTMAT_CMD , ALLOW_NC |ALLOW_RING}
@@ -405 +407 @@
 ,{D(jjTIMES_MA_I2),'*',           MATRIX_CMD,     INT_CMD,    MATRIX_CMD, ALLOW_NC | ALLOW_RING}
 ,{D(jjTIMES_MA),  '*',            MATRIX_CMD,     MATRIX_CMD, MATRIX_CMD, ALLOW_NC | ALLOW_RING}
-,{D(jjTIMES_SM),  '*',            SMATRIX_CMD,    SMATRIX_CMD,SMATRIX_CMD, ALLOW_NC | ALLOW_RING}
 ,{D(jjTIMES_MA_BI1),'*',          MATRIX_CMD,     MATRIX_CMD, BIGINT_CMD, ALLOW_NC | ALLOW_RING}
 ,{D(jjTIMES_MA_BI2),'*',          MATRIX_CMD,     BIGINT_CMD, MATRIX_CMD, ALLOW_NC | ALLOW_RING}
+,{D(jjTIMES_SM),  '*',            SMATRIX_CMD,    SMATRIX_CMD,SMATRIX_CMD, ALLOW_NC | ALLOW_RING}
 ,{D(jjTIMES_BIM), '*',            BIGINTMAT_CMD,  BIGINTMAT_CMD, BIGINTMAT_CMD, ALLOW_NC | ALLOW_RING}
 ,{D(jjOP_BIM_I),  '*',            BIGINTMAT_CMD,  BIGINTMAT_CMD, INT_CMD, ALLOW_NC | ALLOW_RING}
@@ -747 +749 @@
 ,{D(jjSYZ_2),     SYZYGY_CMD,     MODUL_CMD,      IDEAL_CMD,  STRING_CMD, ALLOW_PLURAL |ALLOW_RING}
 ,{D(jjSYZ_2),     SYZYGY_CMD,     MODUL_CMD,      MODUL_CMD,  STRING_CMD, ALLOW_PLURAL |ALLOW_RING}
+,{D(jjTENSOR),    TENSOR_CMD,     SMATRIX_CMD,    SMATRIX_CMD,SMATRIX_CMD, ALLOW_PLURAL |ALLOW_RING}
 ,{D(jjVARSTR2),   VARSTR_CMD,     STRING_CMD,     RING_CMD,   INT_CMD, ALLOW_NC |ALLOW_RING}
 ,{D(jjWAIT1ST2),  WAIT1ST_CMD,    INT_CMD,        LIST_CMD,   INT_CMD, ALLOW_NC |ALLOW_RING}
@@ -1178 +1181 @@
   { "system",      0, SYSTEM_CMD,         CMD_M},
   { "syz",         0, SYZYGY_CMD ,        CMD_12},
+  { "tensor",      0, TENSOR_CMD ,        CMD_2},
   { "test",        0, TEST_CMD ,          CMD_M},
   { "trace",       0, TRACE_CMD ,         CMD_1},

Singular/tok.h

@@ -185 +185 @@
   SYSTEM_CMD,
   SYZYGY_CMD,
+  TENSOR_CMD,
   TEST_CMD,
   TRANSPOSE_CMD,