/****************************************************************************
**
*F DiffVecFFEFFE(<vecL>,<elmR>) difference of a vector and a fin field elm
**
** 'DiffVecFFEFFE' returns the difference of the vector <vecL> and the
** finite field element <elmR>. The difference is a list, where each
** element is the difference of <elmR> and the corresponding element of
** <vecL>.
**
** 'DiffVecFFEFFE' is an improved version of 'DiffListScl', which does not
** call 'DIFF'.
*/
Obj DiffVecFFEFFE (
Obj vecL,
Obj elmR )
{
Obj vecD; /* handle of the difference */
Obj * ptrD; /* pointer into the difference */
FFV valD; /* the value of a difference */
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 DiffListScl(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 DIFF(vecL, elmR);
}
/* make the result list */
len = LEN_PLIST(vecL);
vecD = NEW_PLIST(IS_MUTABLE_OBJ(vecL) ?
T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len);
SET_LEN_PLIST(vecD, len);
/* to subtract we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and subtract */
valR = VAL_FFE(elmR);
valR = NEG_FFV(valR, succ);
ptrL = ADDR_OBJ(vecL);
ptrD = ADDR_OBJ(vecD);
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valD = SUM_FFV(valL, valR, succ);
ptrD[i] = NEW_FFE(fld, valD);
}
/* return the result */
return vecD;
}
/****************************************************************************
**
*F SumFFEVecFFE(<elmL>,<vecR>) . . . . sum of an fin field elm and a vector
**
** 'SumFFEVecFFE' returns the sum of the fin field elm <elmL> and the vector
** <vecR>. The sum is a list, where each element is the sum of <elmL> and
** the corresponding element of <vecR>.
**
** 'SumFFEVecFFE' is an improved version of 'SumSclList', which does not
** call 'SUM'.
*/
Obj SumFFEVecFFE (
Obj elmL,
Obj vecR )
{
Obj vecS; /* handle of the sum */
Obj * ptrS; /* pointer into the sum */
FFV valS; /* the value of a sum */
Obj * ptrR; /* pointer into the right operand */
FFV valR; /* the value of an element in vecR */
UInt len; /* length */
UInt i; /* loop variable */
FF fld; /* finite field */
FF * succ; /* successor table */
FFV valL; /* the value of elmL */
/* get the field and check that elmL and vecR have the same field */
fld = FLD_FFE(ELM_PLIST(vecR, 1));
if (FLD_FFE(elmL) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(elmL)))
return SumSclList(elmL, vecR);
elmL = ErrorReturnObj(
"<elm>+<vec>: <elm> and <vec> must belong to the same finite field",
0L, 0L, "you can replace <elm> via 'return <elm>;'");
return SUM(elmL, vecR);
}
/* make the result list */
len = LEN_PLIST(vecR);
vecS = NEW_PLIST(IS_MUTABLE_OBJ(vecR) ?
T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len);
SET_LEN_PLIST(vecS, len);
/* to add we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and add */
valL = VAL_FFE(elmL);
ptrR = ADDR_OBJ(vecR);
ptrS = ADDR_OBJ(vecS);
for (i = 1; i <= len; i++) {
valR = VAL_FFE(ptrR[i]);
valS = SUM_FFV(valL, valR, succ);
ptrS[i] = NEW_FFE(fld, valS);
}
/* return the result */
return vecS;
}
/****************************************************************************
**
*F DiffVecFFEVecFFE(<vecL>,<vecR>) . . . . . . . . difference of two vectors
**
** 'DiffVecFFEVecFFE' returns the difference of the two vectors <vecL> and
** <vecR>. The difference is a new list, where each element is the
** difference of the corresponding elements of <vecL> and <vecR>.
**
** 'DiffVecFFEVecFFE' is an improved version of 'DiffListList', which does
** not call 'DIFF'.
*/
Obj DiffVecFFEVecFFE (
Obj vecL,
Obj vecR )
{
Obj vecD; /* handle of the difference */
Obj * ptrD; /* pointer into the difference */
FFV valD; /* one element of difference list */
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 len, lenL, lenR; /* length */
UInt lenmin;
UInt i; /* loop variable */
FF fld; /* finite field */
FF * succ; /* successor table */
/* check the lengths */
lenL = LEN_PLIST(vecL);
lenR = LEN_PLIST(vecR);
if (lenR > lenL) {
len = lenR;
lenmin = lenL;
} else {
len = lenL;
lenmin = 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 DiffListList(vecL, vecR);
vecR = ErrorReturnObj(
"Vector -: vectors have different fields",
0L, 0L, "you can replace vector <right> via 'return <right>;'");
return DIFF(vecL, vecR);
}
/* make the result list */
vecD = NEW_PLIST((IS_MUTABLE_OBJ(vecL) || IS_MUTABLE_OBJ(vecR)) ?
T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len);
SET_LEN_PLIST(vecD, len);
/* to subtract we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and subtract */
ptrL = ADDR_OBJ(vecL);
ptrR = ADDR_OBJ(vecR);
ptrD = ADDR_OBJ(vecD);
for (i = 1; i <= lenmin; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valR = NEG_FFV(valR, succ);
valD = SUM_FFV(valL, valR, succ);
ptrD[i] = NEW_FFE(fld, valD);
}
if (lenL < lenR)
for (; i <= len; i++) {
valR = VAL_FFE(ptrR[i]);
valD = NEG_FFV(valR, succ);
ptrD[i] = NEW_FFE(fld, valD);
}
else
for (; i <= len; i++)
ptrD[i] = ptrL[i];
/* return the result */
return vecD;
}
/****************************************************************************
**
*F FuncADD_SET( <self>, <set>, <obj> ) . . . . . . . add an element to a set
**
** 'FuncADD_SET' implements the internal function 'AddSet'.
**
** 'AddSet( <set>, <obj> )'
**
** 'AddSet' adds <obj>, which may be an object of an arbitrary type, to the
** set <set>, which must be a proper set. If <obj> is already an element of
** the set <set>, then <set> is not changed. Otherwise <obj> is inserted at
** the correct position such that <set> is again a set afterwards.
**
** 'AddSet' does not return anything, it is only called for the side effect
** of changing <set>.
*/
Obj FuncADD_SET (
Obj self,
Obj set,
Obj obj )
{
UInt len; /* logical length of the list */
UInt pos; /* position */
UInt isCyc; /* True if the set being added to consists
of kernel cyclotomics */
UInt notpos; /* position of an original element
(not the new one) */
UInt wasHom;
UInt wasNHom;
UInt wasTab;
/* check the arguments */
while ( ! IsSet(set) || ! IS_MUTABLE_OBJ(set) ) {
set = ErrorReturnObj(
"AddSet: <set> must be a mutable proper set (not a %s)",
(Int)TNAM_OBJ(set), 0L,
"you can replace <set> via 'return <set>;'" );
}
len = LEN_LIST(set);
/* perform the binary search to find the position */
pos = PositionSortedDensePlist( set, obj );
/* add the element to the set if it is not already there */
if ( len < pos || ! EQ( ELM_PLIST(set,pos), obj ) ) {
GROW_PLIST( set, len+1 );
SET_LEN_PLIST( set, len+1 );
{
Obj *ptr;
ptr = PTR_BAG(set);
memmove((void *)(ptr + pos+1),(void*)(ptr+pos),(size_t)(sizeof(Obj)*(len+1-pos)));
#if 0
for ( i = len+1; pos < i; i-- ) {
*ptr = *(ptr-1);
ptr--; */
/* SET_ELM_PLIST( set, i, ELM_PLIST(set,i-1) ); */
}
#endif
}
SET_ELM_PLIST( set, pos, obj );
CHANGED_BAG( set );
/* fix up the type of the result */
if ( HAS_FILT_LIST( set, FN_IS_SSORT ) ) {
isCyc = (TNUM_OBJ(set) == T_PLIST_CYC_SSORT);
wasHom = HAS_FILT_LIST(set, FN_IS_HOMOG);
wasTab = HAS_FILT_LIST(set, FN_IS_TABLE);
wasNHom = HAS_FILT_LIST(set, FN_IS_NHOMOG);
CLEAR_FILTS_LIST(set);
/* the result of addset is always dense */
SET_FILT_LIST( set, FN_IS_DENSE );
/* if the object we added was not
mutable then we might be able to
conclude more */
if ( ! IS_MUTABLE_OBJ(obj) ) {
/* a one element list is automatically
homogenous and ssorted */
if (len == 0 )
{
if (TNUM_OBJ(obj) <= T_CYC)
RetypeBag( set, T_PLIST_CYC_SSORT);
else
{
SET_FILT_LIST( set, FN_IS_HOMOG );
SET_FILT_LIST( set, FN_IS_SSORT );
if (IS_HOMOG_LIST(obj)) /* it might be a table */
SET_FILT_LIST( set, FN_IS_TABLE );
}
}
else
{
/* Now determine homogeneity */
if (isCyc)
if (TNUM_OBJ(obj) <= T_CYC)
RetypeBag( set, T_PLIST_CYC_SSORT);
else
{
RESET_FILT_LIST(set, FN_IS_HOMOG);
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
else if (wasHom)
{
if (!SyInitializing) {
notpos = (pos == 1) ? 2 : 1;
if (FAMILY_OBJ(ELM_PLIST(set,notpos)) == FAMILY_OBJ(obj))
{
SET_FILT_LIST(set, FN_IS_HOMOG);
if (wasTab) {
if (IS_HOMOG_LIST( obj ))
SET_FILT_LIST(set, FN_IS_TABLE);
}
}
else
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
}
else if (wasNHom)
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
}
SET_FILT_LIST( set, FN_IS_SSORT );
}
else {
CLEAR_FILTS_LIST(set);
SET_FILT_LIST( set, FN_IS_DENSE );
}
}