/**************************************************************************** ** ** This file is part of GAP, a system for computational discrete algebra. ** ** Copyright of GAP belongs to its developers, whose names are too numerous ** to list here. Please refer to the COPYRIGHT file for details. ** ** SPDX-License-Identifier: GPL-2.0-or-later
*/
/***************************************************************************** * * A partial perm is of the form: * * [image set, domain, codegree, entries of image list] * * An element of the internal rep of a partial perm in T_PPERM2 must be * at most 65535 and be of UInt2. The <codegree> is just the degree of * the inverse or equivalently the maximum element of the image. *
*****************************************************************************/
#define RequirePartialPerm(funcname, op) \
RequireArgumentCondition(funcname, op, IS_PPERM(op), \ "must be a partial permutation")
static ModuleStateOffset PPermStateOffset = -1;
typedefstruct {
/************************************************************************** * *V TmpPPerm . . . . . . . handle of the buffer bag of the pperm package * * 'TmpPPerm' is the handle of a bag of type 'T_PPERM4', which is * created at initialization time of this package. Functions in this * package can use this bag for whatever purpose they want. They have * to make sure of course that it is large enough. * * The buffer is *not* guaranteed to have any particular value, routines * that require a zero-initialization need to do this at the start.
*/
Obj TmpPPerm;
Obj NEW_PPERM2(UInt deg)
{ // No assert since the values stored in this pperm must be UInt2s but the // degree might be a UInt4. return NEW_PPERM<UInt2>(deg);
}
cpt = INT_INTOBJ(pt); if (cpt > CODEG_PPERM<T>(f)) return Fail;
i = 0;
ptf = CONST_ADDR_PPERM<T>(f);
deg = DEG_PPERM<T>(f); while (i < deg && ptf[i] != cpt)
i++; if (i == deg || ptf[i] != cpt) return Fail; return INTOBJ_INT(i + 1);
}
/***************************************************************************** * GAP functions for partial perms
*****************************************************************************/
// find if we are PPERM2 or PPERM4
codeg = 0;
i = deg; while (codeg < 65536 && i > 0) {
j = INT_INTOBJ(ELM_LIST(img, i--)); if (j > codeg)
codeg = j;
} if (codeg < 65536) {
f = NEW_PPERM2(deg);
ptf2 = ADDR_PPERM2(f); for (i = 0; i < deg; i++) {
j = INT_INTOBJ(ELM_LIST(img, i + 1));
*ptf2++ = (UInt2)j;
}
SET_CODEG_PPERM2(f, codeg); // codeg is already known
} else {
f = NEW_PPERM4(deg);
ptf4 = ADDR_PPERM4(f); for (i = 0; i < deg; i++) {
j = INT_INTOBJ(ELM_LIST(img, i + 1)); if (j > codeg)
codeg = j;
*ptf4++ = (UInt4)j;
}
SET_CODEG_PPERM4(f, codeg);
} return f;
}
// assumes that dom is a set and that img is duplicatefree static Obj FuncSparsePartialPermNC(Obj self, Obj dom, Obj img)
{
RequireSmallList(SELF_NAME, dom);
RequireSmallList(SELF_NAME, img);
RequireSameLength(SELF_NAME, dom, img);
// find if we are PPERM2 or PPERM4
codeg = 0;
i = rank; while (codeg < 65536 && i > 0) {
j = INT_INTOBJ(ELM_PLIST(img, i--)); if (j > codeg)
codeg = j;
}
// create the pperm if (codeg < 65536) {
f = NEW_PPERM2(deg);
ptf2 = ADDR_PPERM2(f); for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(img, i));
ptf2[INT_INTOBJ(ELM_PLIST(dom, i)) - 1] = j;
}
SET_CODEG_PPERM2(f, codeg);
} else {
f = NEW_PPERM4(deg);
ptf4 = ADDR_PPERM4(f); for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(img, i)); if (j > codeg)
codeg = j;
ptf4[INT_INTOBJ(ELM_PLIST(dom, i)) - 1] = j;
}
SET_CODEG_PPERM4(f, codeg);
}
SET_DOM_PPERM(f, dom);
SET_IMG_PPERM(f, img);
CHANGED_BAG(f); return f;
}
// the degree of pperm is the maximum point where it is defined static Obj FuncDegreeOfPartialPerm(Obj self, Obj f)
{
RequirePartialPerm(SELF_NAME, f); return INTOBJ_INT(DEG_PPERM(f));
}
// the codegree of pperm is the maximum point in its image
// the rank is the number of points where it is defined static Obj FuncRankOfPartialPerm(Obj self, Obj f)
{
RequirePartialPerm(SELF_NAME, f); return INTOBJ_INT(RANK_PPERM(f));
}
// domain of a partial perm static Obj FuncDOMAIN_PPERM(Obj self, Obj f)
{
RequirePartialPerm(SELF_NAME, f);
if (DOM_PPERM(f) == NULL) {
INIT_PPERM(f);
} return DOM_PPERM(f);
}
// image list of pperm static Obj FuncIMAGE_PPERM(Obj self, Obj f)
{
RequirePartialPerm(SELF_NAME, f);
if (TNUM_OBJ(f) == T_PPERM2) {
deg = DEG_PPERM2(f);
ptf2 = ADDR_PPERM2(f);
dom = DOM_PPERM(f);
// find chains for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1; if (ptseen[j] == 0) {
ptseen[j] = 2;
len = 1; for (k = ptf2[j]; (k <= deg && ptf2[k - 1] != 0);
k = ptf2[k - 1]) {
len++;
ptseen[k - 1] = 2;
}
ptseen[k - 1] = 2; if (len > pow)
pow = len;
}
}
// find cycles for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1; if (ptseen[j] == 1) {
len = 1; for (k = ptf2[j]; k != j + 1; k = ptf2[k - 1]) {
len++;
ptseen[k - 1] = 0;
}
ord = LcmInt(ord, INTOBJ_INT(len)); // update ptseen, in case a garbage collection happened
ptseen = ADDR_PPERM4(TmpPPerm);
}
}
} else {
deg = DEG_PPERM4(f);
ptf4 = ADDR_PPERM4(f);
dom = DOM_PPERM(f);
// find chains for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1; if (ptseen[j] == 0) {
ptseen[j] = 2;
len = 1; for (k = ptf4[j]; (k <= deg && ptf4[k - 1] != 0);
k = ptf4[k - 1]) {
len++;
ptseen[k - 1] = 2;
}
ptseen[k - 1] = 2; if (len > pow)
pow = len;
}
}
// find cycles for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1; if (ptseen[j] == 1) {
len = 1; for (k = ptf4[j]; k != j + 1; k = ptf4[k - 1]) {
len++;
ptseen[k - 1] = 0;
}
ord = LcmInt(ord, INTOBJ_INT(len)); // update ptseen, in case a garbage collection happened
ptseen = ADDR_PPERM4(TmpPPerm);
}
}
} return NewPlistFromArgs(INTOBJ_INT(pow + 1), ord);
}
// the least power of <f> which is an idempotent static Obj FuncSMALLEST_IDEM_POW_PPERM(Obj self, Obj f)
{
RequirePartialPerm(SELF_NAME, f);
Obj x, ind, per, pow;
x = FuncINDEX_PERIOD_PPERM(self, f);
ind = ELM_PLIST(x, 1);
per = ELM_PLIST(x, 2);
pow = per; while (LtInt(pow, ind))
pow = SumInt(pow, per); return pow;
}
// returns the least list <out> such that for all <i> in [1..degree(f)] // there exists <j> in <out> and a pos int <k> such that <j^(f^k)=i>. static Obj FuncCOMPONENT_REPS_PPERM(Obj self, Obj f)
{
RequirePartialPerm(SELF_NAME, f);
// the number of components of a partial perm (as a functional digraph) static Obj FuncNR_COMPONENTS_PPERM(Obj self, Obj f)
{
RequirePartialPerm(SELF_NAME, f);
UInt i, j, n, rank, k, deg, nr;
UInt2 * ptf2;
UInt4 * ptseen, *ptf4;
Obj dom, img;
// the points that can be obtained from <pt> by successively applying <f>. static Obj FuncCOMPONENT_PPERM_INT(Obj self, Obj f, Obj pt)
{
RequirePartialPerm(SELF_NAME, f);
RequireSmallInt(SELF_NAME, pt);
UInt i, j, deg, len;
Obj out;
i = INT_INTOBJ(pt);
if (TNUM_OBJ(f) == T_PPERM2) {
deg = DEG_PPERM2(f);
if (i > deg || (ADDR_PPERM2(f))[i - 1] == 0) {
out = NewEmptyPlist(); return out;
}
if (codeg < 65536) {
g = NEW_PPERM2(codeg);
ptg2 = ADDR_PPERM2(g); for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(img, i)) - 1;
ptg2[j] = j + 1;
} if (IS_SSORT_LIST(img)) {
SET_DOM_PPERM(g, img);
SET_IMG_PPERM(g, img);
}
SET_CODEG_PPERM2(g, codeg);
} else {
g = NEW_PPERM4(codeg);
ptg4 = ADDR_PPERM4(g); for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(img, i)) - 1;
ptg4[j] = j + 1;
} if (IS_SSORT_LIST(img)) {
SET_DOM_PPERM(g, img);
SET_IMG_PPERM(g, img);
}
SET_CODEG_PPERM4(g, codeg);
}
CHANGED_BAG(g); return g;
}
// f<=g if and only if f is a restriction of g template <typename TF, typename TG> static Obj NaturalLeqPartialPerm(Obj f, Obj g)
{
UInt def, deg, i, j, rank; const TF * ptf; const TG * ptg;
Obj dom;
// the union of f and g where this defines an injective function template <typename TF, typename TG> static Obj JOIN_PPERMS(Obj f, Obj g)
{ typedeftypename ResultType<TF, TG>::type Res;
for (i = 0; i < deg; i++) {
j = IMAGEPP(i + 1, ptf4, degf); if (IMAGEPP(i + 1, ptg4, degg) == j) {
ptmeet4[i] = j; if (j > codeg)
codeg = j;
}
}
SET_CODEG_PPERM4(meet, codeg);
} return meet;
}
// restricted partial perm where set is assumed to be a set of positive ints static Obj FuncRESTRICTED_PPERM(Obj self, Obj f, Obj set)
{
GAP_ASSERT(IS_LIST(set));
UInt i, j, n, codeg, deg;
UInt2 *ptf2, *ptg2;
UInt4 *ptf4, *ptg4;
Obj g;
// find pos in list corresponding to degree of new pperm while (n > 0 && (UInt)INT_INTOBJ(ELM_LIST(set, n)) > deg)
n--; while (n > 0 && ptf2[INT_INTOBJ(ELM_LIST(set, n)) - 1] == 0)
n--; if (n == 0) return EmptyPartialPerm;
g = NEW_PPERM2(INT_INTOBJ(ELM_LIST(set, n)));
ptf2 = ADDR_PPERM2(f);
ptg2 = ADDR_PPERM2(g);
for (i = 0; i < n; i++) {
j = INT_INTOBJ(ELM_LIST(set, i + 1)) - 1;
ptg2[j] = ptf2[j]; if (ptg2[j] > codeg)
codeg = ptg2[j];
}
SET_CODEG_PPERM2(g, codeg); return g;
} elseif (TNUM_OBJ(f) == T_PPERM4) {
deg = DEG_PPERM4(f);
ptf4 = ADDR_PPERM4(f);
while (n > 0 && (UInt)INT_INTOBJ(ELM_LIST(set, n)) > deg)
n--; while (n > 0 && ptf4[INT_INTOBJ(ELM_LIST(set, n)) - 1] == 0)
n--; if (n == 0) return EmptyPartialPerm;
g = NEW_PPERM4(INT_INTOBJ(ELM_LIST(set, n)));
ptf4 = ADDR_PPERM4(f);
ptg4 = ADDR_PPERM4(g);
for (i = 0; i < n; i++) {
j = INT_INTOBJ(ELM_LIST(set, i + 1)) - 1;
ptg4[j] = ptf4[j]; if (ptg4[j] > codeg)
codeg = ptg4[j];
}
SET_CODEG_PPERM4(g, codeg); return g;
} return Fail;
}
// convert a permutation <p> to a partial perm on <set>, which is assumed to // be a set of positive integers static Obj FuncAS_PPERM_PERM(Obj self, Obj p, Obj set)
{
GAP_ASSERT(IS_PERM(p));
GAP_ASSERT(IS_LIST(set));
UInt i, j, n, deg, codeg, dep;
UInt2 *ptf2, *ptp2;
UInt4 *ptf4, *ptp4;
Obj f;
n = LEN_LIST(set); if (n == 0) return EmptyPartialPerm;
deg = INT_INTOBJ(ELM_LIST(set, n));
codeg = 0;
if (TNUM_OBJ(p) == T_PERM2) {
dep = DEG_PERM2(p); if (deg < 65536) { if (dep < deg) {
f = NEW_PPERM2(deg);
ptf2 = ADDR_PPERM2(f);
ptp2 = ADDR_PERM2(p); for (i = 1; i <= n; i++) {
j = INT_INTOBJ(ELM_LIST(set, i)) - 1;
ptf2[j] = IMAGE(j, ptp2, dep) + 1;
}
SET_CODEG_PPERM2(f, deg);
} else { // deg(f)<=deg(p)<=65536
f = NEW_PPERM2(deg);
ptf2 = ADDR_PPERM2(f);
ptp2 = ADDR_PERM2(p); for (i = 1; i <= n; i++) {
j = INT_INTOBJ(ELM_LIST(set, i)) - 1;
ptf2[j] = ptp2[j] + 1; if (ptf2[j] > codeg)
codeg = ptf2[j];
}
SET_CODEG_PPERM2(f, codeg);
}
} else { // deg(p)<=65536<=deg(f)
f = NEW_PPERM4(deg);
ptf4 = ADDR_PPERM4(f);
ptp2 = ADDR_PERM2(p); for (i = 1; i <= n; i++) {
j = INT_INTOBJ(ELM_LIST(set, i)) - 1;
ptf4[j] = IMAGE(j, ptp2, dep) + 1;
}
SET_CODEG_PPERM4(f, deg);
}
} else { // p is PERM4
dep = DEG_PERM4(p); if (dep < deg) {
f = NEW_PPERM4(deg);
ptf4 = ADDR_PPERM4(f);
ptp4 = ADDR_PERM4(p); for (i = 1; i <= n; i++) {
j = INT_INTOBJ(ELM_LIST(set, i)) - 1;
ptf4[j] = IMAGE(j, ptp4, dep) + 1;
}
SET_CODEG_PPERM4(f, deg);
} else { // deg<=dep // find the codeg
i = deg;
ptp4 = ADDR_PERM4(p); while (codeg < 65536 && i > 0) {
j = ptp4[INT_INTOBJ(ELM_LIST(set, i--)) - 1] + 1; if (j > codeg)
codeg = j;
} if (codeg < 65536) {
f = NEW_PPERM2(deg);
ptf2 = ADDR_PPERM2(f);
ptp4 = ADDR_PERM4(p); for (i = 1; i <= n; i++) {
j = INT_INTOBJ(ELM_LIST(set, i)) - 1;
ptf2[j] = ptp4[j] + 1;
}
SET_CODEG_PPERM2(f, codeg);
} else {
f = NEW_PPERM4(deg);
ptf4 = ADDR_PPERM4(f);
ptp4 = ADDR_PERM4(p); for (i = 1; i <= n; i++) {
j = INT_INTOBJ(ELM_LIST(set, i)) - 1;
ptf4[j] = ptp4[j] + 1; if (ptf4[j] > codeg)
codeg = ptf4[j];
}
SET_CODEG_PPERM4(f, deg);
}
}
} return f;
}
// for a partial perm with equal dom and img static Obj FuncAS_PERM_PPERM(Obj self, Obj f)
{
RequirePartialPerm(SELF_NAME, f);
img = FuncIMAGE_SET_PPERM(self, f);
dom = DOM_PPERM(f); if (!EQ(img, dom)) { return Fail;
} if (TNUM_OBJ(f) == T_PPERM2) {
deg = DEG_PPERM2(f);
p = NEW_PERM2(deg);
ptp2 = ADDR_PERM2(p);
ptf2 = ADDR_PPERM2(f); for (i = 0; i < deg; i++)
ptp2[i] = i;
rank = RANK_PPERM2(f); for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
ptp2[j] = ptf2[j] - 1;
}
} else {
deg = DEG_PPERM4(f);
p = NEW_PERM4(deg);
ptp4 = ADDR_PERM4(p);
ptf4 = ADDR_PPERM4(f); for (i = 0; i < deg; i++)
ptp4[i] = i;
rank = RANK_PPERM4(f); for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
ptp4[j] = ptf4[j] - 1;
}
} return p;
}
// the permutation induced on im(f) by f^-1*g when im(g)=im(f) // and dom(f)=dom(g), no checking static Obj FuncPERM_LEFT_QUO_PPERM_NC(Obj self, Obj f, Obj g)
{
RequirePartialPerm(SELF_NAME, f);
RequirePartialPerm(SELF_NAME, g);
// check if we're in the trivial case
def = DEG_PPERM<TF>(f);
deg = DEG_PPERM<TG>(g); if (def == 0 || deg == 0) return EmptyPartialPerm;
ptf = CONST_ADDR_PPERM<TF>(f);
ptg = CONST_ADDR_PPERM<TG>(g);
dom = DOM_PPERM(f);
codeg = CODEG_PPERM<TG>(g);
dec = 0;
codec = 0;
if (dom == NULL) {
min = MIN(def, deg); if (CODEG_PPERM<TF>(f) <= deg) { // find the degree for (i = 0; i < min; i++) { if (ptf[i] != 0 && ptg[i] > dec && ptg[ptf[i] - 1] != 0) {
dec = ptg[i]; if (dec == codeg) break;
}
}
// do nothing in the trivial case if (DEG_PPERM<TG>(g) == 0 || DEG_PPERM<TF>(f) == 0) return EmptyPartialPerm;
// init the buffer bag
deginv = CODEG_PPERM<TG>(g);
ResizeTmpPPerm(deginv);
pttmp = ADDR_PPERM4(TmpPPerm); for (i = 0; i < deginv; i++)
pttmp[i] = 0;
// invert g into the buffer bag
ptg = CONST_ADDR_PPERM<TG>(g); if (DOM_PPERM(g) == NULL) {
deg = DEG_PPERM<TG>(g); for (i = 0; i < deg; i++) if (ptg[i] != 0)
pttmp[ptg[i] - 1] = i + 1;
} else {
dom = DOM_PPERM(g);
rank = RANK_PPERM<TG>(g); for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
pttmp[ptg[j] - 1] = j + 1;
}
}
// find the degree of the quotient
deg = DEG_PPERM<TF>(f);
ptf = CONST_ADDR_PPERM<TF>(f); while (deg > 0 &&
(ptf[deg - 1] == 0 || IMAGEPP(ptf[deg - 1], pttmp, deginv) == 0))
deg--; if (deg == 0) return EmptyPartialPerm;
// create new pperm
quo = NEW_PPERM4(deg);
ptquo = ADDR_PPERM4(quo);
ptf = CONST_ADDR_PPERM<TF>(f);
pttmp = ADDR_PPERM4(TmpPPerm);
codeg = 0;
// compose f with g^-1 in rank operations if (DOM_PPERM(f) != NULL) {
dom = DOM_PPERM(f);
rank = RANK_PPERM<TF>(f); for (i = 1; i <= rank; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1; if (j < deg && ptf[j] <= deginv) {
ptquo[j] = pttmp[ptf[j] - 1]; if (ptquo[j] > codeg)
codeg = ptquo[j];
}
}
} else { // compose f with g^-1 in deg operations for (i = 0; i < deg; i++) { if (ptf[i] != 0 && ptf[i] <= deginv) {
ptquo[i] = pttmp[ptf[i] - 1]; if (ptquo[i] > codeg)
codeg = ptquo[i];
}
}
}
SET_CODEG_PPERM4(quo, codeg); return quo;
}
if (!IS_POS_INTOBJ(i)) {
ErrorQuit("usage: the first argument must be a positive small integer,",
0, 0);
} return INTOBJ_INT(
IMAGEPP((UInt)INT_INTOBJ(i), ADDR_PPERM2(f), DEG_PPERM2(f)));
}
static Obj PowIntPPerm4(Obj i, Obj f)
{
GAP_ASSERT(TNUM_OBJ(f) == T_PPERM4);
if (!IS_POS_INTOBJ(i)) {
ErrorQuit("usage: the first argument must be a positive small integer,",
0, 0);
} return INTOBJ_INT(
IMAGEPP((UInt)INT_INTOBJ(i), ADDR_PPERM4(f), DEG_PPERM4(f)));
}
def = DEG_PPERM<TF>(f); if (def == 0) return EmptyPartialPerm;
dep = DEG_PERM<TP>(p);
dom = DOM_PPERM(f);
if (dep < def) {
lquo = NEW_PPERM<TF>(def);
ptlquo = ADDR_PPERM<TF>(lquo);
ptp = CONST_ADDR_PERM<TP>(p);
ptf = CONST_ADDR_PPERM<TF>(f); if (dom == NULL) { for (i = 0; i < dep; i++)
ptlquo[ptp[i]] = ptf[i]; for (; i < def; i++)
ptlquo[i] = ptf[i];
} else {
len = LEN_PLIST(dom); for (i = 1; i <= len; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
ptlquo[IMAGE(j, ptp, dep)] = ptf[j];
}
}
} else { // deg(p)>=deg(f)
del = 0;
ptp = CONST_ADDR_PERM<TP>(p);
ptf = CONST_ADDR_PPERM<TF>(f); if (dom == NULL) { // find the degree for (i = 0; i < def; i++) { if (ptf[i] != 0 && ptp[i] >= del) {
del = ptp[i] + 1; if (del == dep) break;
}
}
lquo = NEW_PPERM<TF>(del);
ptlquo = ADDR_PPERM<TF>(lquo);
ptp = CONST_ADDR_PERM<TP>(p);
ptf = CONST_ADDR_PPERM<TF>(f);
// if required below in case ptp[i]>del but ptf[i]=0 for (i = 0; i < def; i++) if (ptf[i] != 0)
ptlquo[ptp[i]] = ptf[i];
} else { // dom(f) is known
len = LEN_PLIST(dom); for (i = 1; i <= len; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1; if (ptp[j] >= del) {
del = ptp[j] + 1; if (del == dep) break;
}
}
lquo = NEW_PPERM<TF>(del);
ptlquo = ADDR_PPERM<TF>(lquo);
ptp = CONST_ADDR_PERM<TP>(p);
ptf = CONST_ADDR_PPERM<TF>(f);
for (i = 1; i <= len; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
ptlquo[ptp[j]] = ptf[j];
}
}
}
// check if we're in the trivial case
def = DEG_PPERM<TF>(f);
deg = DEG_PPERM<TG>(g); if (def == 0 || deg == 0) return EmptyPartialPerm;
ptf = CONST_ADDR_PPERM<TF>(f);
ptg = CONST_ADDR_PPERM<TG>(g);
dom = DOM_PPERM(g);
del = 0;
codef = CODEG_PPERM<TF>(f);
codel = 0;
if (dom == NULL) { // find the degree of lquo
min = MIN(def, deg); for (i = 0; i < min; i++) { if (ptg[i] != 0 && ptf[i] > del) {
del = ptf[i]; if (del == codef) break;
}
} if (del == 0) return EmptyPartialPerm;
// multiply for (i = 1; i <= len; i++) {
j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1; if (ptf[j] != 0) {
ptlquo[ptf[j] - 1] = ptg[j]; if (ptg[j] > codel)
codel = ptg[j];
}
}
}
SET_CODEG_PPERM<TG>(lquo, codel); return lquo;
}
/**************************************************************************** ** *F OnSetsPPerm( <set>, <f> ) . . . . . . . . . operations on sets of points ** ** 'OnSetsPPerm' returns the image of the tuple <set> under the partial ** permutation <f>. It is called from 'FuncOnSets'. ** ** The input <set> must be a non-empty set, i.e., plain, dense and strictly ** sorted. This is not verified.
*/
Obj OnSetsPPerm(Obj set, Obj f)
{
UInt2 * ptf2;
UInt4 * ptf4;
UInt deg;
Obj res; const Obj * ptres;
Obj * ptresOut;
UInt i, k, reslen;
Obj tmp;
// copy the list into a mutable plist, which we will then modify in place
res = PLAIN_LIST_COPY(set); const UInt len = LEN_PLIST(res);
// get the pointer
ptres = CONST_ADDR_OBJ(res) + 1;
ptresOut = ADDR_OBJ(res) + 1;
reslen = 0;
// loop over the entries of the tuple for (i = 1; i <= len; i++, ptres++) {
tmp = *ptres; if (IS_POS_INTOBJ(tmp)) {
k = INT_INTOBJ(tmp); if (k <= deg && ptf2[k - 1] != 0) {
reslen++;
*ptresOut++ = INTOBJ_INT(ptf2[k - 1]);
}
} else { // This case currently does not work since PowIntPPerm2/4 only // works for small integers, and returns an error for non-small // integers. The analogous code in permutat.c uses the macro // POW, which calls PowIntPerm2/4, which if called with a // non-small positive integer returns that integer, since every // permutation fixes every non-small positive integer.
ErrorQuit("<set> must be a list of positive small integers", 0, 0);
}
}
} else {
ptf4 = ADDR_PPERM4(f);
deg = DEG_PPERM4(f);
// loop over the entries of the tuple for (i = 1; i <= len; i++, ptres++) {
tmp = *ptres; if (IS_POS_INTOBJ(tmp)) {
k = INT_INTOBJ(tmp); if (k <= deg && ptf4[k - 1] != 0) {
reslen++;
*ptresOut++ = INTOBJ_INT(ptf4[k - 1]);
}
} else { // This case currently does not work since PowIntPPerm2/4 only // works for small integers, and returns an error for non-small // integers. The analogous code in permutat.c uses the macro // POW, which calls PowIntPerm2/4, which if called with a // non-small positive integer returns that integer, since every // permutation fixes every non-small positive integer.
ErrorQuit("<set> must be a list of positive small integers", 0, 0);
}
}
}
/**************************************************************************** ** *F OnTuplesPPerm( <tup>, <f> ) . . . . . . . operations on tuples of points ** ** 'OnTuplesPPerm' returns the image of the tuple <tup> under the ** partial permutation <f>. It is called from 'FuncOnTuples'. ** ** The input <tup> must be a non-empty and dense plain list. This is not ** verified.
*/
Obj OnTuplesPPerm(Obj tup, Obj f)
{
UInt2 * ptf2;
UInt4 * ptf4;
UInt deg;
Obj res; const Obj * ptres;
Obj * ptresOut;
UInt i, k, reslen;
Obj tmp;
// copy the list into a mutable plist, which we will then modify in place
res = PLAIN_LIST_COPY(tup);
RESET_FILT_LIST(res, FN_IS_SSORT);
RESET_FILT_LIST(res, FN_IS_NSORT); const UInt len = LEN_PLIST(res);
// get the pointer
ptres = CONST_ADDR_OBJ(res) + 1;
ptresOut = ADDR_OBJ(res) + 1;
reslen = 0;
// loop over the entries of the tuple for (i = 1; i <= len; i++, ptres++) {
tmp = *ptres; if (IS_POS_INTOBJ(tmp)) {
k = INT_INTOBJ(tmp); if (k <= deg && ptf2[k - 1] != 0) {
reslen++;
*ptresOut++ = INTOBJ_INT(ptf2[k - 1]);
}
} else { // This case currently does not work since PowIntPPerm2/4 only // works for small integers, and returns an error for non-small // integers. The analogous code in permutat.c uses the macro // POW, which calls PowIntPerm2/4, which if called with a // non-small positive integer returns that integer, since every // permutation fixes every non-small positive integer.
ErrorQuit("<tup> must be a list of small integers", 0, 0);
}
}
} else {
ptf4 = ADDR_PPERM4(f);
deg = DEG_PPERM4(f);
// loop over the entries of the tuple for (i = 1; i <= len; i++, ptres++) {
tmp = *ptres; if (IS_POS_INTOBJ(tmp)) {
k = INT_INTOBJ(tmp); if (k <= deg && ptf4[k - 1] != 0) {
reslen++;
*ptresOut++ = INTOBJ_INT(ptf4[k - 1]);
}
} else { // This case currently does not work since PowIntPPerm2/4 only // works for small integers, and returns an error for non-small // integers. The analogous code in permutat.c uses the macro // POW, which calls PowIntPerm2/4, which if called with a // non-small positive integer returns that integer, since every // permutation fixes every non-small positive integer.
ErrorQuit("<tup> must be a list of small integers", 0, 0);
}
}
}
SET_LEN_PLIST(res, reslen);
SHRINK_PLIST(res, reslen);
// init filters and functions
InitHdlrFiltsFromTable(GVarFilts);
InitHdlrFuncsFromTable(GVarFuncs);
// register global bags with the garbage collector
InitGlobalBag(&TmpPPerm, "src/pperm.c:TmpPPerm");
InitGlobalBag(&EmptyPartialPerm, "src/pperm.c:EmptyPartialPerm");
// install the one function for partial perms
OneFuncs[T_PPERM2] = OnePPerm;
OneFuncs[T_PPERM4] = OnePPerm;
OneSameMut[T_PPERM2] = OnePPerm;
OneSameMut[T_PPERM4] = OnePPerm;
// install the inverse functions for partial perms
InvFuncs[T_PPERM2] = InvPPerm2;
InvFuncs[T_PPERM4] = InvPPerm4;
InvSameMutFuncs[T_PPERM2] = InvPPerm2;
InvSameMutFuncs[T_PPERM4] = InvPPerm4;
// We make the following partial perms to allow testing of some parts of // the code which would not otherwise be accessible, since no partial perm // created in this file is a T_PPERM4 can have degree 0, for example. Such // partial perm can be created by packages with a kernel module, and so we // introduce these partial perms for testing purposes.
Obj EMPTY_PPERM4 = NEW_PPERM4(0);
AssReadOnlyGVar(GVarName("EMPTY_PPERM4"), EMPTY_PPERM4);