/****************************************************************************
**
*F CommDefault( <opL>, <opR> ) . . . . . . . . . . . call 'LQUO' and 'PROD'
*/
Obj CommDefault (
Obj opL,
Obj opR )
{
Obj tmp1;
Obj tmp2;
tmp1 = PROD( opR, opL );
tmp2 = PROD( opL, opR );
return LQUO( tmp1, tmp2 );
}
/****************************************************************************
**
*F SCTableProduct( <table>, <list1>, <list2> ) . product wrt structure table
**
** 'SCTableProduct' returns the product of the two elements <list1> and
** <list2> with respect to the structure constants table <table>.
*/
void SCTableProdAdd (
Obj res,
Obj coeff,
Obj basis_coeffs,
Int dim )
{
Obj basis;
Obj coeffs;
Int len;
Obj k;
Obj c1, c2;
Int l;
basis = ELM_LIST( basis_coeffs, 1 );
coeffs = ELM_LIST( basis_coeffs, 2 );
len = LEN_LIST( basis );
if ( LEN_LIST( coeffs ) != len ) {
ErrorQuit("SCTableProduct: corrupted <table>",0L,0L);
}
for ( l = 1; l <= len; l++ ) {
k = ELM_LIST( basis, l );
if ( ! IS_INTOBJ(k) || INT_INTOBJ(k) <= 0 || dim < INT_INTOBJ(k) ) {
ErrorQuit("SCTableProduct: corrupted <table>",0L,0L);
}
c1 = ELM_LIST( coeffs, l );
c1 = PROD( coeff, c1 );
c2 = ELM_PLIST( res, INT_INTOBJ(k) );
c2 = SUM( c2, c1 );
SET_ELM_PLIST( res, INT_INTOBJ(k), c2 );
CHANGED_BAG( res );
}
}
/****************************************************************************
**
*F FuncPROD( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . call 'PROD'
*/
Obj FuncPROD (
Obj self,
Obj opL,
Obj opR )
{
return PROD( opL, opR );
}
/****************************************************************************
**
*F PowDefault( <opL>, <opR> ) . . . . . . . . . . . call 'LQUO' and 'PROD'
*/
Obj PowDefault (
Obj opL,
Obj opR )
{
Obj tmp;
tmp = LQUO( opR, opL );
return PROD( tmp, opR );
}
/****************************************************************************
**
*F LQuoDefault( <opL>, <opR> ) . . . . . . . . . . . . call 'INV' and 'PROD'
*/
Obj LQuoDefault (
Obj opL,
Obj opR )
{
Obj tmp;
tmp = INV_MUT( opL );
return PROD( tmp, opR );
}
/****************************************************************************
**
*F QuoDefault( <opL>, <opR> ) . . . . . . . . . . . . call 'INV' and 'PROD'
*/
Obj QuoDefault (
Obj opL,
Obj opR )
{
Obj tmp;
tmp = INV_MUT( opR );
return PROD( opL, tmp );
}
/****************************************************************************
**
*F ProdVecFFEVecFFE(<vecL>,<vecR>) . . . . . . . . . product of two vectors
**
** 'ProdVecFFEVecFFE' returns the product of the two vectors <vecL> and
** <vecR>. The product is the sum of the products of the corresponding
** elements of the two lists.
**
** 'ProdVecFFEVecFFE' is an improved version of 'ProdListList', which does
** not call 'PROD'.
*/
Obj ProdVecFFEVecFFE (
Obj vecL,
Obj vecR )
{
FFV valP; /* one product */
FFV valS; /* sum of the products */
Obj * ptrL; /* pointer into the left operand */
FFV valL; /* one element of left operand */
Obj * ptrR; /* pointer into the right operand */
FFV valR; /* one element of right operand */
UInt lenL, lenR, len; /* length */
UInt i; /* loop variable */
FF fld; /* finite field */
FF * succ; /* successor table */
/* check the lengths */
lenL = LEN_PLIST(vecL);
lenR = LEN_PLIST(vecR);
len = (lenL < lenR) ? lenL : lenR;
/* check the fields */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return ProdListList(vecL, vecR);
vecR = ErrorReturnObj(
"Vector *: vectors have different fields",
0L, 0L,
"you can replace vector <right> via 'return <right>;'");
return PROD(vecL, vecR);
}
/* to add we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and add */
valS = (FFV)0;
ptrL = ADDR_OBJ(vecL);
ptrR = ADDR_OBJ(vecR);
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valP = PROD_FFV(valL, valR, succ);
valS = SUM_FFV(valS, valP, succ);
}
/* return the result */
return NEW_FFE(fld, valS);
}
/****************************************************************************
**
*F ProdVecFFEFFE(<vecL>,<elmR>) . product of a vector and a fin field elm
**
** 'ProdVecFFEFFE' returns the product of the finite field element <elmR>
** and the vector <vecL>. The product is the list, where each element is
** the product of <elmR> and the corresponding element of <vecL>.
**
** 'ProdVecFFEFFE' is an improved version of 'ProdSclList', which does not
** call 'PROD'.
*/
Obj ProdVecFFEFFE (
Obj vecL,
Obj elmR )
{
Obj vecP; /* handle of the product */
Obj * ptrP; /* pointer into the product */
FFV valP; /* the value of a product */
Obj * ptrL; /* pointer into the left operand */
FFV valL; /* the value of an element in vecL */
UInt len; /* length */
UInt i; /* loop variable */
FF fld; /* finite field */
FF * succ; /* successor table */
FFV valR; /* the value of elmR */
/* get the field and check that vecL and elmR have the same field */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(elmR) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(elmR)))
return ProdListScl(vecL, elmR);
elmR = ErrorReturnObj(
"<vec>*<elm>: <elm> and <vec> must belong to the same finite field",
0L, 0L, "you can replace <elm> via 'return <elm>;'");
return PROD(vecL, elmR);
}
/* make the result list */
len = LEN_PLIST(vecL);
vecP = NEW_PLIST(IS_MUTABLE_OBJ(vecL) ?
T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len);
SET_LEN_PLIST(vecP, len);
/* to multiply we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and multiply */
valR = VAL_FFE(elmR);
ptrL = ADDR_OBJ(vecL);
ptrP = ADDR_OBJ(vecP);
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valP = PROD_FFV(valL, valR, succ);
ptrP[i] = NEW_FFE(fld, valP);
}
/* return the result */
return vecP;
}
// Derived verb for f//. y
static DF1(jtobqfslash){A y,z;B b=0,p;C er,id,*wv;I c,d,k,m,m1,mn,n,n1,r,*s,wt;
RZ(w);
r=AR(w); s=AS(w); wt=AT(w); wv=CAV(w);
if(!(AN(w)&&1<r&&DENSE&wt))R oblique(w,self); // revert to default if rank<2, empty, or sparse
y=VAV(self)->f; y=VAV(y)->f; id=vaid(y);
m=s[0]; m1=m-1;
n=s[1]; n1=n-1; mn=m*n; d=m+n-1; PROD(c,r-2,2+s);
if(1==m||1==n){GA(z,wt,AN(w),r-1,1+s); *AS(z)=d; MC(AV(z),wv,AN(w)*bp(wt)); R z;}
if(wt&FL+CMPX)NAN0;
if(1==c)switch(OBQCASE(CTTZ(wt),id)){
case OBQCASE(B01X, CNE ): OBQLOOP(B,B,wt,x=*u, x^=*u ); break;
case OBQCASE(B01X, CEQ ): OBQLOOP(B,B,wt,x=*u, x=x==*u ); break;
case OBQCASE(B01X, CMAX ):
case OBQCASE(B01X, CPLUSDOT): OBQLOOP(B,B,wt,x=*u, x|=*u ); break;
case OBQCASE(B01X, CMIN ):
case OBQCASE(B01X, CSTAR ):
case OBQCASE(B01X, CSTARDOT): OBQLOOP(B,B,wt,x=*u, x&=*u ); break;
case OBQCASE(B01X, CLT ): OBQLOOP(B,B,wt,x=*u, x=*u< x ); break;
case OBQCASE(B01X, CLE ): OBQLOOP(B,B,wt,x=*u, x=*u<=x ); break;
case OBQCASE(B01X, CGT ): OBQLOOP(B,B,wt,x=*u, x=*u> x ); break;
case OBQCASE(B01X, CGE ): OBQLOOP(B,B,wt,x=*u, x=*u>=x ); break;
case OBQCASE(B01X, CPLUS ): OBQLOOP(B,I,INT,x=*u, x+=*u ); break;
case OBQCASE(SBTX, CMAX ): OBQLOOP(SB,SB,wt,x=*u, x=SBGT(x,*u)?x:*u ); break;
case OBQCASE(SBTX, CMIN ): OBQLOOP(SB,SB,wt,x=*u, x=SBLT(x,*u)?x:*u ); break;
case OBQCASE(FLX, CMAX ): OBQLOOP(D,D,wt,x=*u, x=MAX(x,*u) ); break;
case OBQCASE(FLX, CMIN ): OBQLOOP(D,D,wt,x=*u, x=MIN(x,*u) ); break;
case OBQCASE(FLX, CPLUS ): OBQLOOP(D,D,wt,x=*u, x+=*u ); break;
case OBQCASE(CMPXX,CPLUS ): OBQLOOP(Z,Z,wt,x=*u, x=zplus(x,*u)); break;
case OBQCASE(XNUMX,CMAX ): OBQLOOP(X,X,wt,x=*u, x=1==xcompare(x,*u)? x:*u); break;
case OBQCASE(XNUMX,CMIN ): OBQLOOP(X,X,wt,x=*u, x=1==xcompare(x,*u)?*u: x); break;
case OBQCASE(XNUMX,CPLUS ): OBQLOOP(X,X,wt,x=*u, x=xplus(x,*u)); break;
case OBQCASE(RATX, CMAX ): OBQLOOP(Q,Q,wt,x=*u, x=1==QCOMP(x,*u)? x:*u); break;
case OBQCASE(RATX, CMIN ): OBQLOOP(Q,Q,wt,x=*u, x=1==QCOMP(x,*u)?*u: x); break;
case OBQCASE(RATX, CPLUS ): OBQLOOP(Q,Q,wt,x=*u, x=qplus(x,*u)); break;
case OBQCASE(INTX, CBW0001 ): OBQLOOP(I,I,wt,x=*u, x&=*u ); break;
case OBQCASE(INTX, CBW0110 ): OBQLOOP(I,I,wt,x=*u, x^=*u ); break;
case OBQCASE(INTX, CBW0111 ): OBQLOOP(I,I,wt,x=*u, x|=*u ); break;
case OBQCASE(INTX, CMAX ): OBQLOOP(I,I,wt,x=*u, x=MAX(x,*u) ); break;
case OBQCASE(INTX, CMIN ): OBQLOOP(I,I,wt,x=*u, x=MIN(x,*u) ); break;
case OBQCASE(INTX, CPLUS ):
er=0; OBQLOOP(I,I,wt,x=*u, {p=0>x; x+=*u; BOV(p==0>*u&&p!=0>x);});
if(er>=EWOV)OBQLOOP(I,D,FL,x=(D)*u, x+=*u);
}
/****************************************************************************
**
*F ProdVectorMatrix(<vecL>,<vecR>) . . . . product of a vector and a matrix
**
** 'ProdVectorMatrix' returns the product of the vector <vecL> and the matrix
** <vecR>. The product is the sum of the rows of <vecR>, each multiplied by
** the corresponding entry of <vecL>.
**
** 'ProdVectorMatrix' is an improved version of 'ProdListList', which does
** not call 'PROD' and also accumulates the sum into one fixed vector
** instead of allocating a new for each product and sum.
*/
Obj ProdVecFFEMatFFE (
Obj vecL,
Obj matR )
{
Obj vecP; /* handle of the product */
Obj * ptrP; /* pointer into the product */
FFV * ptrV; /* value pointer into the product */
FFV valP; /* one value of the product */
FFV valL; /* one value of the left operand */
Obj vecR; /* one vector of the right operand */
Obj * ptrR; /* pointer into the right vector */
FFV valR; /* one value from the right vector */
UInt len; /* length */
UInt col; /* length of the rows in matR */
UInt i, k; /* loop variables */
FF fld; /* the common finite field */
FF * succ; /* the successor table */
/* check the lengths */
len = LEN_PLIST(vecL);
col = LEN_PLIST(ELM_PLIST(matR, 1));
if (len != LEN_PLIST(matR)) {
matR = ErrorReturnObj(
"<vec>*<mat>: <vec> (%d) must have the same length as <mat> (%d)",
(Int)len, (Int)col,
"you can replace matrix <mat> via 'return <mat>;'");
return PROD(vecL, matR);
}
/* check the fields */
vecR = ELM_PLIST(matR, 1);
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return ProdListList(vecL, matR);
matR = ErrorReturnObj(
"<vec>*<mat>: <vec> and <mat> have different fields",
0L, 0L,
"you can replace matrix <mat> via 'return <mat>;'");
return PROD(vecL, matR);
}
/* make the result list by multiplying the first entries */
vecP = ProdFFEVecFFE(ELM_PLIST(vecL, 1), vecR);
/* to add we need the successor table */
succ = SUCC_FF(fld);
/* convert vecP into a list of values */
/*N 5Jul1998 werner: This only works if sizeof(FFV) <= sizeof(Obj) */
/*N We have to be careful not to overwrite the length info */
ptrP = ADDR_OBJ(vecP);
ptrV = ((FFV*)(ptrP + 1)) - 1;
for (k = 1; k <= col; k++)
ptrV[k] = VAL_FFE(ptrP[k]);
/* loop over the other entries and multiply */
for (i = 2; i <= len; i++) {
valL = VAL_FFE(ELM_PLIST(vecL, i));
vecR = ELM_PLIST(matR, i);
ptrR = ADDR_OBJ(vecR);
if (valL == (FFV)1) {
for (k = 1; k <= col; k++) {
valR = VAL_FFE(ptrR[k]);
valP = ptrV[k];
ptrV[k] = SUM_FFV(valP, valR, succ);
}
} else if (valL != (FFV)0) {
for (k = 1; k <= col; k++) {
valR = VAL_FFE(ptrR[k]);
valR = PROD_FFV(valL, valR, succ);
valP = ptrV[k];
ptrV[k] = SUM_FFV(valP, valR, succ);
}
}
}
/* convert vecP back into a list of finite field elements */
/*N 5Jul1998 werner: This only works if sizeof(FFV) <= sizeof(Obj) */
/*N We have to be careful not to overwrite the length info */
for (k = col; k >= 1; k--)
ptrP[k] = NEW_FFE(fld, ptrV[k]);
/* return the result */
return vecP;
}
Obj SCTableProductHandler (
Obj self,
Obj table,
Obj list1,
Obj list2 )
{
Obj res; /* result list */
Obj row; /* one row of sc table */
Obj zero; /* zero from sc table */
Obj ai, aj; /* elements from list1 */
Obj bi, bj; /* elements from list2 */
Obj c, c1, c2; /* products of above */
Int dim; /* dimension of vectorspace */
Int i, j; /* loop variables */
/* check the arguments a bit */
if ( ! IS_SMALL_LIST(table) ) {
table = ErrorReturnObj(
"SCTableProduct: <table> must be a list (not a %s)",
(Int)TNAM_OBJ(table), 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
dim = LEN_LIST(table) - 2;
if ( dim <= 0 ) {
table = ErrorReturnObj(
"SCTableProduct: <table> must be a list with at least 3 elements",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
zero = ELM_LIST( table, dim+2 );
if ( ! IS_SMALL_LIST(list1) || LEN_LIST(list1) != dim ) {
list1 = ErrorReturnObj(
"SCTableProduct: <list1> must be a list with %d elements",
dim, 0L,
"you can replace <list1> via 'return <list1>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
if ( ! IS_SMALL_LIST(list2) || LEN_LIST(list2) != dim ) {
list2 = ErrorReturnObj(
"SCTableProduct: <list2> must be a list with %d elements",
dim, 0L,
"you can replace <list2> via 'return <list2>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
/* make the result list */
res = NEW_PLIST( T_PLIST, dim );
SET_LEN_PLIST( res, dim );
for ( i = 1; i <= dim; i++ ) {
SET_ELM_PLIST( res, i, zero );
}
CHANGED_BAG( res );
/* general case */
if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(0) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
if ( EQ( ai, zero ) ) continue;
row = ELM_LIST( table, i );
for ( j = 1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
if ( EQ( bj, zero ) ) continue;
c = PROD( ai, bj );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* commutative case */
else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(1) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
bi = ELM_LIST( list2, i );
if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue;
row = ELM_LIST( table, i );
c = PROD( ai, bi );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, i ), dim );
}
for ( j = i+1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
aj = ELM_LIST( list1, j );
if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue;
c1 = PROD( ai, bj );
c2 = PROD( aj, bi );
c = SUM( c1, c2 );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* anticommutative case */
else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(-1) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
bi = ELM_LIST( list2, i );
if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue;
row = ELM_LIST( table, i );
for ( j = i+1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
aj = ELM_LIST( list1, j );
if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue;
c1 = PROD( ai, bj );
c2 = PROD( aj, bi );
c = DIFF( c1, c2 );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* return the result */
return res;
}
Obj GAP_PROD(Obj a, Obj b)
{
return PROD(a, b);
}
