Quelle pperm.cc Sprache: C

/****************************************************************************
**
**  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.
*
*****************************************************************************/

extern "C" {

#include "pperm.h"

#include "ariths.h"
#include "bool.h"
#include "error.h"
#include "gapstate.h"
#include "gvars.h"
#include "integer.h"
#include "intfuncs.h"
#include "io.h"
#include "listfunc.h"
#include "lists.h"
#include "modules.h"
#include "opers.h"
#include "permutat.h"
#include "plist.h"
#include "saveload.h"

} // extern "C"

#include "permutat_intern.hh"

//
// convert TNUM to underlying C data type
//
template <UInt tnum>
struct DataType;

template <>
struct DataType<T_PPERM2> {
    typedef UInt2 type;
};
template <>
struct DataType<T_PPERM4> {
    typedef UInt4 type;
};

//
// convert underlying C data type to TNUM
//
template <typename T>
struct T_PPERM {
};
template <>
struct T_PPERM<UInt2> {
    static const UInt tnum = T_PPERM2;
};
template <>
struct T_PPERM<UInt4> {
    static const UInt tnum = T_PPERM4;
};

//
// Various helper functions for partial permutations
//
template <typename T>
static void ASSERT_IS_PPERM(Obj pperm)
{
    GAP_ASSERT(TNUM_OBJ(pperm) == T_PPERM<T>::tnum);
}

template <typename T>
static inline T * ADDR_PPERM(Obj f)
{
    ASSERT_IS_PPERM<T>(f);
    return (T *)(ADDR_OBJ(f) + 2) + 1;
}

template <typename T>
static inline const T * CONST_ADDR_PPERM(Obj f)
{
    ASSERT_IS_PPERM<T>(f);
    return (const T *)(CONST_ADDR_OBJ(f) + 2) + 1;
}

template <typename T>
static inline UInt DEG_PPERM(Obj f)
{
    ASSERT_IS_PPERM<T>(f);
    return (UInt)(SIZE_OBJ(f) - sizeof(T) - 2 * sizeof(Obj)) / sizeof(T);
}

#define MAX(a, b) (a < b ? b : a)
#define MIN(a, b) (a < b ? a : b)

#define IMAGEPP(i, ptf, deg) (i <= deg ? ptf[i - 1] : 0)

static Obj EmptyPartialPerm;

#define RequirePartialPerm(funcname, op)                                     \
    RequireArgumentCondition(funcname, op, IS_PPERM(op),                     \
                             "must be a partial permutation")

static ModuleStateOffset PPermStateOffset = -1;

typedef struct {

    /**************************************************************************
     *
     *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;

} PPermModuleState;

#define TmpPPerm MODULE_STATE(PPerm).TmpPPerm

static inline void ResizeTmpPPerm(UInt len)
{
    if (TmpPPerm == (Obj)0) {
        TmpPPerm =
            NewBag(T_PPERM4, (len + 1) * sizeof(UInt4) + 2 * sizeof(Obj));
    }
    else if (SIZE_OBJ(TmpPPerm) <
             (len + 1) * sizeof(UInt4) + 2 * sizeof(Obj)) {
        ResizeBag(TmpPPerm, (len + 1) * sizeof(UInt4) + 2 * sizeof(Obj));
    }
}

/*****************************************************************************
* Static functions for partial perms
*****************************************************************************/

template <typename T>
static inline UInt GET_CODEG_PPERM(Obj f)
{
    ASSERT_IS_PPERM<T>(f);
    return *(const T *)(CONST_ADDR_OBJ(f) + 2);
}

template <typename T>
static inline void SET_CODEG_PPERM(Obj f, T codeg)
{
    ASSERT_IS_PPERM<T>(f);
    *(T *)(ADDR_OBJ(f) + 2) = codeg;
}

template <typename T>
static UInt CODEG_PPERM(Obj f)
{
    ASSERT_IS_PPERM<T>(f);
    if (GET_CODEG_PPERM<T>(f) != 0) {
        return GET_CODEG_PPERM<T>(f);
    }
    // The following is only ever entered by the EmptyPartialPerm.
    UInt    codeg = 0;
    UInt    i;
    const T * ptf = CONST_ADDR_PPERM<T>(f);
    for (i = 0; i < DEG_PPERM<T>(f); i++) {
        if (ptf[i] > codeg) {
            codeg = ptf[i];
        }
    }
    SET_CODEG_PPERM<T>(f, codeg);
    return codeg;
}

static inline void SET_CODEG_PPERM2(Obj f, UInt2 codeg)
{
    SET_CODEG_PPERM<UInt2>(f, codeg);
}

static inline void SET_CODEG_PPERM4(Obj f, UInt4 codeg)
{
    SET_CODEG_PPERM<UInt4>(f, codeg);
}

UInt CODEG_PPERM2(Obj f)
{
    return CODEG_PPERM<UInt2>(f);
}

UInt CODEG_PPERM4(Obj f)
{
    return CODEG_PPERM<UInt4>(f);
}

template <typename T>
static inline Obj NEW_PPERM(UInt deg)
{
    return NewBag(T_PPERM<T>::tnum, (deg + 1) * sizeof(T) + 2 * sizeof(Obj));

}

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);
}

Obj NEW_PPERM4(UInt deg)
{
    return NEW_PPERM<UInt4>(deg);
}

static inline Obj IMG_PPERM(Obj f)
{
    GAP_ASSERT(IS_PPERM(f));
    return CONST_ADDR_OBJ(f)[0];
}

static inline Obj DOM_PPERM(Obj f)
{
    GAP_ASSERT(IS_PPERM(f));
    return CONST_ADDR_OBJ(f)[1];
}

static inline void SET_IMG_PPERM(Obj f, Obj img)
{
    GAP_ASSERT(IS_PPERM(f));
    GAP_ASSERT(IS_PLIST(img) && !IS_PLIST_MUTABLE(img));
    GAP_ASSERT(DOM_PPERM(f) == NULL ||
               LEN_PLIST(img) == LEN_PLIST(DOM_PPERM(f)));
    // TODO check entries of img are valid
    ADDR_OBJ(f)[0] = img;
}

static inline void SET_DOM_PPERM(Obj f, Obj dom)
{
    GAP_ASSERT(IS_PPERM(f));
    GAP_ASSERT(IS_PLIST(dom) && !IS_PLIST_MUTABLE(dom));
    GAP_ASSERT(IMG_PPERM(f) == NULL ||
               LEN_PLIST(dom) == LEN_PLIST(IMG_PPERM(f)));
    // TODO check entries of img are valid
    ADDR_OBJ(f)[1] = dom;
}

// find domain and img set (unsorted) return the rank

template <typename T>
static UInt INIT_PPERM(Obj f)
{
    ASSERT_IS_PPERM<T>(f);

    UInt    deg, rank, i;
    T *     ptf;
    Obj     img, dom;

    deg = DEG_PPERM<T>(f);

    if (deg == 0) {
        dom = NewImmutableEmptyPlist();
        SET_DOM_PPERM(f, dom);
        SET_IMG_PPERM(f, dom);
        CHANGED_BAG(f);
        return deg;
    }

    dom = NEW_PLIST_IMM(T_PLIST_CYC_SSORT, deg);
    img = NEW_PLIST_IMM(T_PLIST_CYC, deg);

    // renew the ptr in case of garbage collection
    ptf = ADDR_PPERM<T>(f);

    rank = 0;
    for (i = 0; i < deg; i++) {
        if (ptf[i] != 0) {
            rank++;
            SET_ELM_PLIST(dom, rank, INTOBJ_INT(i + 1));
            SET_ELM_PLIST(img, rank, INTOBJ_INT(ptf[i]));
        }
    }
    GAP_ASSERT(rank != 0);    // rank = 0 => deg = 0, so this is not allowed

    SHRINK_PLIST(img, (Int)rank);
    SET_LEN_PLIST(img, (Int)rank);
    SHRINK_PLIST(dom, (Int)rank);
    SET_LEN_PLIST(dom, (Int)rank);

    SET_DOM_PPERM(f, dom);
    SET_IMG_PPERM(f, img);
    CHANGED_BAG(f);
    return rank;
}

static UInt INIT_PPERM(Obj f)
{
    if (TNUM_OBJ(f) == T_PPERM2) {
        return INIT_PPERM<UInt2>(f);
    }
    else {
        return INIT_PPERM<UInt4>(f);
    }
}

template <typename T>
static UInt RANK_PPERM(Obj f)
{
    ASSERT_IS_PPERM<T>(f);
    return (IMG_PPERM(f) == NULL ? INIT_PPERM<T>(f)
                                 : LEN_PLIST(IMG_PPERM(f)));
}

UInt RANK_PPERM2(Obj f)
{
    return RANK_PPERM<UInt2>(f);
}

UInt RANK_PPERM4(Obj f)
{
    return RANK_PPERM<UInt4>(f);
}

static Obj SORT_PLIST_INTOBJ(Obj res)
{
    GAP_ASSERT(IS_PLIST(res));
    if (LEN_PLIST(res) == 0)
        return res;

    SortPlistByRawObj(res);
    RetypeBagSM(res, T_PLIST_CYC_SSORT);
    return res;
}

template <typename T>
static Obj PreImagePPermInt(Obj pt, Obj f)
{
    GAP_ASSERT(IS_INTOBJ(pt));
    ASSERT_IS_PPERM<T>(f);

    const T * ptf;
    UInt    i, cpt, 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
*****************************************************************************/

static Obj FuncEmptyPartialPerm(Obj self)
{
    return EmptyPartialPerm;
}

// method for creating a partial perm
static Obj FuncDensePartialPermNC(Obj self, Obj img)
{
    RequireSmallList(SELF_NAME, img);

    UInt    deg, i, j, codeg;
    UInt2 * ptf2;
    UInt4 * ptf4;
    Obj     f;

    if (LEN_LIST(img) == 0)
        return EmptyPartialPerm;

    // remove trailing 0s
    deg = LEN_LIST(img);
    while (deg > 0 && ELM_LIST(img, deg) == INTOBJ_INT(0))
        deg--;

    if (deg == 0)
        return EmptyPartialPerm;

    // 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);

    UInt    rank, deg, i, j, codeg;
    Obj     f;
    UInt2 * ptf2;
    UInt4 * ptf4;

    if (LEN_LIST(dom) == 0)
        return EmptyPartialPerm;

    // make sure we have plain lists
    if (!IS_PLIST(dom))
        dom = PLAIN_LIST_COPY(dom);
    if (!IS_PLIST(img))
        img = PLAIN_LIST_COPY(img);

    // make img immutable
    MakeImmutable(img);
    MakeImmutable(dom);

    rank = LEN_PLIST(dom);
    deg = INT_INTOBJ(ELM_PLIST(dom, rank));

    // 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

static Obj FuncCoDegreeOfPartialPerm(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);
    return INTOBJ_INT(CODEG_PPERM(f));
}

// 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 (IMG_PPERM(f) == NULL) {
        INIT_PPERM(f);
        return IMG_PPERM(f);
    }
    else if (!IS_SSORT_LIST(IMG_PPERM(f))) {
        return IMG_PPERM(f);
    }

    UInt rank = RANK_PPERM(f);
    if (rank == 0) {
        return NewImmutableEmptyPlist();
    }

    Obj dom = DOM_PPERM(f);
    Obj out = NEW_PLIST_IMM(T_PLIST_CYC, rank);
    SET_LEN_PLIST(out, rank);

    if (TNUM_OBJ(f) == T_PPERM2) {
        UInt2 * ptf2 = ADDR_PPERM2(f);
        for (UInt i = 1; i <= rank; i++) {
            SET_ELM_PLIST(
                out, i, INTOBJ_INT(ptf2[INT_INTOBJ(ELM_PLIST(dom, i)) - 1]));
        }
    }
    else {
        UInt4 * ptf4 = ADDR_PPERM4(f);
        for (UInt i = 1; i <= rank; i++) {
            SET_ELM_PLIST(
                out, i, INTOBJ_INT(ptf4[INT_INTOBJ(ELM_PLIST(dom, i)) - 1]));
        }
    }
    return out;
}

// image set of partial perm
static Obj FuncIMAGE_SET_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    if (IMG_PPERM(f) == NULL) {
        INIT_PPERM(f);
        return SORT_PLIST_INTOBJ(IMG_PPERM(f));
    }
    else if (!IS_SSORT_LIST(IMG_PPERM(f))) {
        return SORT_PLIST_INTOBJ(IMG_PPERM(f));
    }
    return IMG_PPERM(f);
}

// preimage under a partial perm
static Obj FuncPREIMAGE_PPERM_INT(Obj self, Obj f, Obj pt)
{
    RequirePartialPerm(SELF_NAME, f);
    RequireSmallInt(SELF_NAME, pt);
    if (TNUM_OBJ(f) == T_PPERM2)
        return PreImagePPermInt<UInt2>(pt, f);
    else
        return PreImagePPermInt<UInt4>(pt, f);
}

// find img(f)
static UInt4 * FindImg(UInt n, UInt rank, Obj img)
{
    GAP_ASSERT(IS_PLIST(img));

    UInt    i;
    UInt4 * ptseen;

    ResizeTmpPPerm(n);
    ptseen = ADDR_PPERM4(TmpPPerm);
    memset(ptseen, 0, n * sizeof(UInt4));

    for (i = 1; i <= rank; i++)
        ptseen[INT_INTOBJ(ELM_PLIST(img, i)) - 1] = 1;

    return ptseen;
}

// the least m, r such that f^m=f^m+r
static Obj FuncINDEX_PERIOD_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt    i, len, j, pow, rank, k, deg, n;
    UInt2 * ptf2;
    UInt4 * ptseen, *ptf4;
    Obj     dom, img, ord;

    pow = 0;
    ord = INTOBJ_INT(1);
    n = MAX(DEG_PPERM(f), CODEG_PPERM(f));

    rank = RANK_PPERM(f);
    img = IMG_PPERM(f);
    ptseen = FindImg(n, rank, img);

    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);

    UInt    i, j, rank, k, deg, nr, n;
    UInt2 * ptf2;
    UInt4 * ptseen, *ptf4;
    Obj     dom, img, out;

    n = MAX(DEG_PPERM(f), CODEG_PPERM(f));

    if (n == 0) {
        out = NewEmptyPlist();
        return out;
    }

    deg = DEG_PPERM(f);
    nr = 0;
    out = NEW_PLIST(T_PLIST_CYC, deg);

    rank = RANK_PPERM(f);
    img = IMG_PPERM(f);
    ptseen = FindImg(n, rank, img);

    if (TNUM_OBJ(f) == T_PPERM2) {
        dom = DOM_PPERM(f);
        ptf2 = ADDR_PPERM2(f);

        // find chains
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i));
            if (ptseen[j - 1] == 0) {
                for (k = j; (k <= deg && ptf2[k - 1] != 0); k = ptf2[k - 1])
                    ptseen[k - 1] = 2;
                ptseen[k - 1] = 2;
                SET_ELM_PLIST(out, ++nr, ELM_PLIST(dom, i));
            }
        }

        // find cycles
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            if (ptseen[j] == 1) {
                ptseen[j] = 0;
                for (k = ptf2[j]; k != j + 1; k = ptf2[k - 1])
                    ptseen[k - 1] = 0;
                SET_ELM_PLIST(out, ++nr, ELM_PLIST(dom, i));
            }
        }
    }
    else {
        dom = DOM_PPERM(f);
        ptf4 = ADDR_PPERM4(f);

        // find chains
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i));
            if (ptseen[j - 1] == 0) {
                for (k = j; (k <= deg && ptf4[k - 1] != 0); k = ptf4[k - 1])
                    ptseen[k - 1] = 2;
                ptseen[k - 1] = 2;
                SET_ELM_PLIST(out, ++nr, ELM_PLIST(dom, i));
            }
        }

        // find cycles
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            if (ptseen[j] == 1) {
                ptseen[j] = 0;
                for (k = ptf4[j]; k != j + 1; k = ptf4[k - 1])
                    ptseen[k - 1] = 0;
                SET_ELM_PLIST(out, ++nr, ELM_PLIST(dom, i));
            }
        }
    }

    SHRINK_PLIST(out, (Int)nr);
    SET_LEN_PLIST(out, (Int)nr);
    return out;
}

// 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;

    n = MAX(DEG_PPERM(f), CODEG_PPERM(f));
    nr = 0;

    rank = RANK_PPERM(f);
    img = IMG_PPERM(f);
    ptseen = FindImg(n, rank, img);

    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));
            if (ptseen[j - 1] == 0) {
                nr++;
                for (k = j; (k <= deg && ptf2[k - 1] != 0); k = ptf2[k - 1])
                    ptseen[k - 1] = 2;
                ptseen[k - 1] = 2;
            }
        }

        // find cycles
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            if (ptseen[j] == 1) {
                nr++;
                ptseen[j] = 0;
                for (k = ptf2[j]; k != j + 1; k = ptf2[k - 1])
                    ptseen[k - 1] = 0;
            }
        }
    }
    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));
            if (ptseen[j - 1] == 0) {
                nr++;
                for (k = j; (k <= deg && ptf4[k - 1] != 0); k = ptf4[k - 1])
                    ptseen[k - 1] = 2;
                ptseen[k - 1] = 2;
            }
        }

        // find cycles
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            if (ptseen[j] == 1) {
                nr++;
                ptseen[j] = 0;
                for (k = ptf4[j]; k != j + 1; k = ptf4[k - 1])
                    ptseen[k - 1] = 0;
            }
        }
    }
    return INTOBJ_INT(nr);
}

// the components of a partial perm (as a functional digraph)
static Obj FuncCOMPONENTS_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt i, j, n, rank, k, deg, nr, len;
    Obj  dom, img, out;

    n = MAX(DEG_PPERM(f), CODEG_PPERM(f));

    if (n == 0) {
        out = NewEmptyPlist();
        return out;
    }

    nr = 0;

    rank = RANK_PPERM(f);
    img = IMG_PPERM(f);
    out = NEW_PLIST(T_PLIST_CYC, rank);
    FindImg(n, rank, img);

    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = DEG_PPERM2(f);
        dom = DOM_PPERM(f);

        // find chains
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i));
            if (CONST_ADDR_PPERM4(TmpPPerm)[j - 1] == 0) {
                SET_ELM_PLIST(out, ++nr, NEW_PLIST(T_PLIST_CYC, 30));
                CHANGED_BAG(out);
                len = 0;
                k = j;
                do {
                    AssPlist(ELM_PLIST(out, nr), ++len, INTOBJ_INT(k));
                    ADDR_PPERM4(TmpPPerm)[k - 1] = 2;
                    k = IMAGEPP(k, ADDR_PPERM2(f), deg);
                } while (k != 0);
                SHRINK_PLIST(ELM_PLIST(out, nr), len);
                SET_LEN_PLIST(ELM_PLIST(out, nr), (Int)len);
                CHANGED_BAG(out);
            }
        }

        // find cycles
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i));
            if (CONST_ADDR_PPERM4(TmpPPerm)[j - 1] == 1) {
                SET_ELM_PLIST(out, ++nr, NEW_PLIST(T_PLIST_CYC, 30));
                CHANGED_BAG(out);
                len = 0;
                k = j;
                do {
                    AssPlist(ELM_PLIST(out, nr), ++len, INTOBJ_INT(k));
                    ADDR_PPERM4(TmpPPerm)[k - 1] = 0;
                    k = ADDR_PPERM2(f)[k - 1];
                } while (k != j);
                SHRINK_PLIST(ELM_PLIST(out, nr), len);
                SET_LEN_PLIST(ELM_PLIST(out, nr), (Int)len);
                CHANGED_BAG(out);
            }
        }
    }
    else {
        deg = DEG_PPERM4(f);
        dom = DOM_PPERM(f);

        // find chains
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i));
            if (CONST_ADDR_PPERM4(TmpPPerm)[j - 1] == 0) {
                SET_ELM_PLIST(out, ++nr, NEW_PLIST(T_PLIST_CYC, 30));
                CHANGED_BAG(out);
                len = 0;
                k = j;
                do {
                    AssPlist(ELM_PLIST(out, nr), ++len, INTOBJ_INT(k));
                    ADDR_PPERM4(TmpPPerm)[k - 1] = 2;
                    k = IMAGEPP(k, ADDR_PPERM4(f), deg);
                } while (k != 0);
                SHRINK_PLIST(ELM_PLIST(out, nr), len);
                SET_LEN_PLIST(ELM_PLIST(out, nr), (Int)len);
                CHANGED_BAG(out);
            }
        }

        // find cycles
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i));
            if (CONST_ADDR_PPERM4(TmpPPerm)[j - 1] == 1) {
                SET_ELM_PLIST(out, ++nr, NEW_PLIST(T_PLIST_CYC, 30));
                CHANGED_BAG(out);
                len = 0;
                k = j;
                do {
                    AssPlist(ELM_PLIST(out, nr), ++len, INTOBJ_INT(k));
                    ADDR_PPERM4(TmpPPerm)[k - 1] = 0;
                    k = ADDR_PPERM4(f)[k - 1];
                } while (k != j);
                SHRINK_PLIST(ELM_PLIST(out, nr), len);
                SET_LEN_PLIST(ELM_PLIST(out, nr), (Int)len);
                CHANGED_BAG(out);
            }
        }
    }

    SHRINK_PLIST(out, (Int)nr);
    SET_LEN_PLIST(out, (Int)nr);
    return out;
}

// 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;
        }

        out = NEW_PLIST(T_PLIST_CYC, 30);
        len = 0;
        j = i;

        do {
            AssPlist(out, ++len, INTOBJ_INT(j));
            j = IMAGEPP(j, ADDR_PPERM2(f), deg);
        } while (j != 0 && j != i);
    }
    else {
        deg = DEG_PPERM4(f);

        if (i > deg || (ADDR_PPERM4(f))[i - 1] == 0) {
            out = NewEmptyPlist();
            return out;
        }

        out = NEW_PLIST(T_PLIST_CYC, 30);
        len = 0;
        j = i;

        do {
            AssPlist(out, ++len, INTOBJ_INT(j));
            j = IMAGEPP(j, ADDR_PPERM4(f), deg);
        } while (j != 0 && j != i);
    }
    SHRINK_PLIST(out, (Int)len);
    SET_LEN_PLIST(out, (Int)len);
    return out;
}

// the fixed points of a partial perm
static Obj FuncFIXED_PTS_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt    len, i, j, deg, rank;
    Obj     out, dom;
    UInt2 * ptf2;
    UInt4 * ptf4;

    len = 0;
    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = DEG_PPERM2(f);
        if (DOM_PPERM(f) == NULL) {
            out = NEW_PLIST(T_PLIST_CYC_SSORT, deg);
            ptf2 = ADDR_PPERM2(f);
            for (i = 0; i < deg; i++) {
                if (ptf2[i] == i + 1) {
                    SET_ELM_PLIST(out, ++len, INTOBJ_INT(i + 1));
                }
            }
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM2(f);
            out = NEW_PLIST(T_PLIST_CYC_SSORT, rank);
            ptf2 = ADDR_PPERM2(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i));
                if (ptf2[j - 1] == j) {
                    SET_ELM_PLIST(out, ++len, INTOBJ_INT(j));
                }
            }
        }
    }
    else {
        deg = DEG_PPERM4(f);
        if (DOM_PPERM(f) == NULL) {
            out = NEW_PLIST(T_PLIST_CYC_SSORT, deg);
            ptf4 = ADDR_PPERM4(f);
            for (i = 0; i < deg; i++) {
                if (ptf4[i] == i + 1) {
                    SET_ELM_PLIST(out, ++len, INTOBJ_INT(i + 1));
                }
            }
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM4(f);
            out = NEW_PLIST(T_PLIST_CYC_SSORT, rank);
            ptf4 = ADDR_PPERM4(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i));
                if (ptf4[j - 1] == j) {
                    SET_ELM_PLIST(out, ++len, INTOBJ_INT(j));
                }
            }
        }
    }
    if (len == 0)
        RetypeBag(out, T_PLIST_EMPTY);

    SHRINK_PLIST(out, len);
    SET_LEN_PLIST(out, (Int)len);

    return out;
}

static Obj FuncNR_FIXED_PTS_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt    nr, i, j, deg, rank;
    Obj     dom;
    UInt2 * ptf2;
    UInt4 * ptf4;

    nr = 0;
    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = DEG_PPERM2(f);
        ptf2 = ADDR_PPERM2(f);
        if (DOM_PPERM(f) == NULL) {
            for (i = 0; i < deg; i++)
                if (ptf2[i] == i + 1)
                    nr++;
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM2(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf2[j] == j + 1)
                    nr++;
            }
        }
    }
    else {
        deg = DEG_PPERM4(f);
        ptf4 = ADDR_PPERM4(f);
        if (DOM_PPERM(f) == NULL) {
            for (i = 0; i < deg; i++)
                if (ptf4[i] == i + 1)
                    nr++;
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM4(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf4[j] == j + 1)
                    nr++;
            }
        }
    }
    return INTOBJ_INT(nr);
}

// the moved points of a partial perm
static Obj FuncMOVED_PTS_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt    len, i, j, deg, rank;
    Obj     out, dom;
    UInt2 * ptf2;
    UInt4 * ptf4;

    len = 0;
    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = DEG_PPERM2(f);
        if (DOM_PPERM(f) == NULL) {
            out = NEW_PLIST(T_PLIST_CYC_SSORT, deg);
            ptf2 = ADDR_PPERM2(f);
            for (i = 0; i < deg; i++) {
                if (ptf2[i] != 0 && ptf2[i] != i + 1) {
                    SET_ELM_PLIST(out, ++len, INTOBJ_INT(i + 1));
                }
            }
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM2(f);
            out = NEW_PLIST(T_PLIST_CYC_SSORT, rank);
            ptf2 = ADDR_PPERM2(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf2[j] != j + 1) {
                    SET_ELM_PLIST(out, ++len, INTOBJ_INT(j + 1));
                }
            }
        }
    }
    else {
        deg = DEG_PPERM4(f);
        if (DOM_PPERM(f) == NULL) {
            out = NEW_PLIST(T_PLIST_CYC_SSORT, deg);
            ptf4 = ADDR_PPERM4(f);
            for (i = 0; i < deg; i++) {
                if (ptf4[i] != 0 && ptf4[i] != i + 1) {
                    SET_ELM_PLIST(out, ++len, INTOBJ_INT(i + 1));
                }
            }
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM4(f);
            out = NEW_PLIST(T_PLIST_CYC_SSORT, rank);
            ptf4 = ADDR_PPERM4(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf4[j] != j + 1) {
                    SET_ELM_PLIST(out, ++len, INTOBJ_INT(j + 1));
                }
            }
        }
    }
    if (len == 0)
        RetypeBag(out, T_PLIST_EMPTY);
    SHRINK_PLIST(out, len);
    SET_LEN_PLIST(out, (Int)len);
    return out;
}

static Obj FuncNR_MOVED_PTS_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt    nr, i, j, deg, rank;
    Obj     dom;
    UInt2 * ptf2;
    UInt4 * ptf4;

    nr = 0;
    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = DEG_PPERM2(f);
        ptf2 = ADDR_PPERM2(f);
        if (DOM_PPERM(f) == NULL) {
            for (i = 0; i < deg; i++)
                if (ptf2[i] != 0 && ptf2[i] != i + 1)
                    nr++;
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM2(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf2[j] != j + 1)
                    nr++;
            }
        }
    }
    else {
        deg = DEG_PPERM4(f);
        ptf4 = ADDR_PPERM4(f);
        if (DOM_PPERM(f) == NULL) {
            for (i = 0; i < deg; i++)
                if (ptf4[i] != 0 && ptf4[i] != i + 1)
                    nr++;
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM4(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf4[j] != j + 1)
                    nr++;
            }
        }
    }
    return INTOBJ_INT(nr);
}

static Obj FuncLARGEST_MOVED_PT_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt    i, j, deg;
    Obj     dom;
    UInt2 * ptf2;
    UInt4 * ptf4;

    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = DEG_PPERM2(f);
        ptf2 = ADDR_PPERM2(f);
        if (DOM_PPERM(f) == NULL) {
            for (i = deg; i > 0; i--) {
                if (ptf2[i - 1] != 0 && ptf2[i - 1] != i)
                    return INTOBJ_INT(i);
            }
        }
        else {
            dom = DOM_PPERM(f);
            for (i = RANK_PPERM2(f); i >= 1; i--) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf2[j] != j + 1)
                    return INTOBJ_INT(j + 1);
            }
        }
    }
    else {
        deg = DEG_PPERM4(f);
        ptf4 = ADDR_PPERM4(f);
        if (DOM_PPERM(f) == NULL) {
            for (i = deg; i > 0; i--) {
                if (ptf4[i - 1] != 0 && ptf4[i - 1] != i)
                    return INTOBJ_INT(i);
            }
        }
        else {
            dom = DOM_PPERM(f);
            for (i = RANK_PPERM4(f); i >= 1; i--) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf4[j] != j + 1)
                    return INTOBJ_INT(j + 1);
            }
        }
    }
    return INTOBJ_INT(0);
}

static Obj FuncSMALLEST_MOVED_PT_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt    i, j, deg, rank;
    Obj     dom;
    UInt2 * ptf2;
    UInt4 * ptf4;

    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = DEG_PPERM2(f);
        ptf2 = ADDR_PPERM2(f);
        if (DOM_PPERM(f) == NULL) {
            for (i = 0; i < deg; i++) {
                if (ptf2[i] != 0 && ptf2[i] != i + 1)
                    return INTOBJ_INT(i + 1);
            }
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM2(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf2[j] != j + 1)
                    return INTOBJ_INT(j + 1);
            }
        }
    }
    else {
        deg = DEG_PPERM4(f);
        ptf4 = ADDR_PPERM4(f);
        if (DOM_PPERM(f) == NULL) {
            for (i = 0; i < deg; i++) {
                if (ptf4[i] != 0 && ptf4[i] != i + 1)
                    return INTOBJ_INT(i + 1);
            }
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM4(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf4[j] != j + 1)
                    return INTOBJ_INT(j + 1);
            }
        }
    }
    return Fail;
}

// convert a T_PPERM4 with codeg<65536 to a T_PPERM2
static Obj FuncTRIM_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt    deg, i;
    UInt4 * ptf;

    if (TNUM_OBJ(f) != T_PPERM4 || CODEG_PPERM4(f) > 65535)
        return f;

    ptf = ADDR_PPERM4(f) - 1;
    deg = DEG_PPERM4(f);
    for (i = 0; i < deg + 1; i++)
        ((UInt2 *)ptf)[i] = (UInt2)ptf[i];

    RetypeBag(f, T_PPERM2);
    ResizeBag(f, (deg + 1) * sizeof(UInt2) + 2 * sizeof(Obj));
    return (Obj)0;
}

Int HashFuncForPPerm(Obj f)
{
    UInt codeg;

    GAP_ASSERT(TNUM_OBJ(f) == T_PPERM2 || TNUM_OBJ(f) == T_PPERM4);

    if (TNUM_OBJ(f) == T_PPERM4) {
        codeg = CODEG_PPERM4(f);
        if (codeg < 65536) {
            FuncTRIM_PPERM(0, f);
        }
        else {
            return HASHKEY_BAG_NC(f, (UInt4)255,
                                  2 * sizeof(Obj) + sizeof(UInt4),
                                  (int)4 * DEG_PPERM4(f));
        }
    }
    return HASHKEY_BAG_NC(f, (UInt4)255, 2 * sizeof(Obj) + sizeof(UInt2),
                          (int)2 * DEG_PPERM2(f));
}

static Obj FuncHASH_FUNC_FOR_PPERM(Obj self, Obj f, Obj data)
{
    return INTOBJ_INT(HashFuncForPPerm(f) % INT_INTOBJ(data) + 1);
}

// test if a partial perm is an idempotent
static Obj FuncIS_IDEM_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    UInt2 * ptf2;
    UInt4 * ptf4;
    UInt    deg, i, j, rank;
    Obj     dom;

    if (TNUM_OBJ(f) == T_PPERM2) {
        ptf2 = ADDR_PPERM2(f);
        if (DOM_PPERM(f) == NULL) {
            deg = DEG_PPERM2(f);
            for (i = 0; i < deg; i++) {
                if (ptf2[i] != 0 && ptf2[i] != i + 1)
                    return False;
            }
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM2(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf2[j] != 0 && ptf2[j] != j + 1)
                    return False;
            }
        }
    }
    else {
        ptf4 = ADDR_PPERM4(f);
        if (DOM_PPERM(f) == NULL) {
            deg = DEG_PPERM4(f);
            for (i = 0; i < deg; i++) {
                if (ptf4[i] != 0 && ptf4[i] != i + 1)
                    return False;
            }
        }
        else {
            dom = DOM_PPERM(f);
            rank = RANK_PPERM4(f);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                if (ptf4[j] != 0 && ptf4[j] != j + 1)
                    return False;
            }
        }
    }
    return True;
}

// an idempotent partial perm <e> with ker(e)=ker(f)
static Obj FuncLEFT_ONE_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    Obj     dom, g;
    UInt    deg, i, j, rank;
    UInt2 * ptg2;
    UInt4 * ptg4;

    if (TNUM_OBJ(f) == T_PPERM2) {
        rank = RANK_PPERM2(f);
        dom = DOM_PPERM(f);
        deg = DEG_PPERM2(f);
    }
    else {
        rank = RANK_PPERM4(f);
        dom = DOM_PPERM(f);
        deg = DEG_PPERM4(f);
    }

    if (deg < 65536) {
        g = NEW_PPERM2(deg);
        ptg2 = ADDR_PPERM2(g);
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            ptg2[j] = j + 1;
        }
        SET_CODEG_PPERM2(g, deg);
        SET_DOM_PPERM(g, dom);
        SET_IMG_PPERM(g, dom);
    }
    else {
        g = NEW_PPERM4(deg);
        ptg4 = ADDR_PPERM4(g);
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            ptg4[j] = j + 1;
        }
        SET_CODEG_PPERM4(g, deg);
        SET_DOM_PPERM(g, dom);
        SET_IMG_PPERM(g, dom);
    }
    CHANGED_BAG(g);
    return g;
}

// an idempotent partial perm <e> with im(e)=im(f)
static Obj FuncRIGHT_ONE_PPERM(Obj self, Obj f)
{
    RequirePartialPerm(SELF_NAME, f);

    Obj     g, img;
    UInt    i, j, codeg, rank;
    UInt2 * ptg2;
    UInt4 * ptg4;

    if (TNUM_OBJ(f) == T_PPERM2) {
        codeg = CODEG_PPERM2(f);
        rank = RANK_PPERM2(f);
        img = IMG_PPERM(f);
    }
    else {
        codeg = CODEG_PPERM4(f);
        rank = RANK_PPERM4(f);
        img = IMG_PPERM(f);
    }

    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;

    def = DEG_PPERM<TF>(f);
    ptf = CONST_ADDR_PPERM<TF>(f);
    if (def == 0)
        return True;

    deg = DEG_PPERM<TG>(g);
    ptg = CONST_ADDR_PPERM<TG>(g);
    if (DOM_PPERM(f) == NULL) {
        for (i = 0; i < def; i++) {
            if (ptf[i] != 0 && ptf[i] != IMAGEPP(i + 1, ptg, deg))
                return False;
        }
    }
    else {
        dom = DOM_PPERM(f);
        rank = RANK_PPERM<TF>(f);
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i));
            if (ptf[j - 1] != IMAGEPP(j, ptg, deg))
                return False;
        }
    }

    return True;
}

static Obj FuncNaturalLeqPartialPerm(Obj self, Obj f, Obj g)
{
    RequirePartialPerm(SELF_NAME, f);
    RequirePartialPerm(SELF_NAME, g);

    if (TNUM_OBJ(f) == T_PPERM2 && TNUM_OBJ(g) == T_PPERM2) {
        return NaturalLeqPartialPerm<UInt2, UInt2>(f, g);
    }
    else if (TNUM_OBJ(f) == T_PPERM2 && TNUM_OBJ(g) == T_PPERM4) {
        return NaturalLeqPartialPerm<UInt2, UInt4>(f, g);
    }
    else if (TNUM_OBJ(f) == T_PPERM4 && TNUM_OBJ(g) == T_PPERM2) {
        return NaturalLeqPartialPerm<UInt4, UInt2>(f, g);
    }
    else /* if (TNUM_OBJ(f) == T_PPERM4 && TNUM_OBJ(g) == T_PPERM4) */ {
        return NaturalLeqPartialPerm<UInt4, UInt4>(f, g);
    }
}

template <typename TF, typename TG>
static Obj JOIN_IDEM_PPERMS(Obj f, Obj g)
{
    typedef typename ResultType<TF, TG>::type Res;

    UInt  def, deg, i;
    Obj   join = NULL;
    Res * ptjoin;
    const TF * ptf;
    const TG * ptg;

    def = DEG_PPERM(f);
    deg = DEG_PPERM(g);

    GAP_ASSERT(def <= deg);

    join = NEW_PPERM<Res>(deg);
    SET_CODEG_PPERM<Res>(join, deg);
    ptjoin = ADDR_PPERM<Res>(join);
    ptf = CONST_ADDR_PPERM<TF>(f);
    ptg = CONST_ADDR_PPERM<TG>(g);
    for (i = 0; i < def; i++) {
        ptjoin[i] = (ptf[i] != 0 ? ptf[i] : ptg[i]);
    }
    for (; i < deg; i++) {
        ptjoin[i] = ptg[i];
    }

    return join;
}

static Obj FuncJOIN_IDEM_PPERMS(Obj self, Obj f, Obj g)
{
    RequirePartialPerm(SELF_NAME, f);
    RequirePartialPerm(SELF_NAME, g);

    UInt def, deg;

    if (EQ(f, g)) {
        return f;
    }

    def = DEG_PPERM(f);
    deg = DEG_PPERM(g);

    if (def > deg) {
        SWAP(Obj, f, g);
        SWAP(UInt, def, deg);
    }

    if (TNUM_OBJ(f) == T_PPERM2 && TNUM_OBJ(g) == T_PPERM2) {
        return JOIN_IDEM_PPERMS<UInt2, UInt2>(f, g);
    }
    else if (TNUM_OBJ(f) == T_PPERM2 && TNUM_OBJ(g) == T_PPERM4) {
        return JOIN_IDEM_PPERMS<UInt2, UInt4>(f, g);
    }
    else /* if (TNUM_OBJ(f) == T_PPERM4 && TNUM_OBJ(g) == T_PPERM4) */ {
        return JOIN_IDEM_PPERMS<UInt4, UInt4>(f, g);
    }
}

// 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)
{
    typedef typename ResultType<TF, TG>::type Res;

    UInt   deg, i, j, degf, degg, codeg, rank;
    Res *   ptjoin;
    const TF * ptf;
    const TG * ptg;
    UInt4 * ptseen;
    Obj    join, dom;

    // init the buffer
    codeg = MAX(CODEG_PPERM(f), CODEG_PPERM(g));
    ResizeTmpPPerm(codeg);
    ptseen = ADDR_PPERM4(TmpPPerm);
    for (i = 0; i < codeg; i++)
        ptseen[i] = 0;

    degf = DEG_PPERM<TF>(f);
    degg = DEG_PPERM<TG>(g);
    deg = MAX(degf, degg);
    join = NEW_PPERM<Res>(deg);
    SET_CODEG_PPERM<Res>(join, codeg);

    ptjoin = ADDR_PPERM<Res>(join);
    ptf = CONST_ADDR_PPERM<TF>(f);
    ptg = CONST_ADDR_PPERM<TG>(g);
    ptseen = ADDR_PPERM4(TmpPPerm);

    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;
            ptjoin[j] = ptf[j];
            ptseen[ptf[j] - 1] = 1;
        }
    }

    if (DOM_PPERM(g) != NULL) {
        dom = DOM_PPERM(g);
        rank = RANK_PPERM<TG>(g);
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            if (ptjoin[j] == 0) {
                if (ptseen[ptg[j] - 1] == 0) {
                    ptjoin[j] = ptg[j];
                    ptseen[ptg[j] - 1] = 1;
                }
                else {
                    return Fail;    // join is not injective
                }
            }
            else if (ptjoin[j] != ptg[j]) {
                return Fail;
            }
        }
    }

    if (DOM_PPERM(f) == NULL) {
        for (i = 0; i < degf; i++) {
            if (ptf[i] != 0) {
                if (ptjoin[i] == 0) {
                    if (ptseen[ptf[i] - 1] == 0) {
                        ptjoin[i] = ptf[i];
                        ptseen[ptf[i] - 1] = 1;
                    }
                    else {
                        return Fail;
                    }
                }
                else if (ptjoin[i] != ptf[i]) {
                    return Fail;
                }
            }
        }
    }

    if (DOM_PPERM(g) == NULL) {
        for (i = 0; i < degg; i++) {
            if (ptg[i] != 0) {
                if (ptjoin[i] == 0) {
                    if (ptseen[ptg[i] - 1] == 0) {
                        ptjoin[i] = ptg[i];
                        ptseen[ptg[i] - 1] = 1;
                    }
                    else {
                        return Fail;
                    }
                }
                else if (ptjoin[i] != ptg[i]) {
                    return Fail;
                }
            }
        }
    }
    return join;
}

static Obj FuncJOIN_PPERMS(Obj self, Obj f, Obj g)
{
    RequirePartialPerm(SELF_NAME, f);
    RequirePartialPerm(SELF_NAME, g);

    if (EQ(f, g))
        return f;

    if (TNUM_OBJ(f) == T_PPERM2 && TNUM_OBJ(g) == T_PPERM2) {
        return JOIN_PPERMS<UInt2, UInt2>(f, g);
    }
    else if (TNUM_OBJ(f) == T_PPERM2 && TNUM_OBJ(g) == T_PPERM4) {
        return JOIN_PPERMS<UInt2, UInt4>(f, g);
    }
    else if (TNUM_OBJ(f) == T_PPERM4 && TNUM_OBJ(g) == T_PPERM2) {
        return JOIN_PPERMS<UInt4, UInt2>(f, g);
    }
    else /* if (TNUM_OBJ(f) == T_PPERM4 && TNUM_OBJ(g) == T_PPERM4) */ {
        return JOIN_PPERMS<UInt4, UInt4>(f, g);
    }
}

static Obj FuncMEET_PPERMS(Obj self, Obj f, Obj g)
{
    RequirePartialPerm(SELF_NAME, f);
    RequirePartialPerm(SELF_NAME, g);

    UInt   deg, i, j, degf, degg, codeg;
    UInt2 *ptf2, *ptg2, *ptmeet2;
    UInt4 *ptf4, *ptg4, *ptmeet4;
    Obj    meet;

    codeg = 0;
    if (TNUM_OBJ(f) == T_PPERM2 && TNUM_OBJ(g) == T_PPERM2) {
        degf = DEG_PPERM2(f);
        degg = DEG_PPERM2(g);
        ptf2 = ADDR_PPERM2(f);
        ptg2 = ADDR_PPERM2(g);

        // find degree
        for (deg = MIN(degf, degg); deg > 0; deg--) {
            j = IMAGEPP(deg, ptf2, degf);
            if (j != 0 && j == IMAGEPP(deg, ptg2, degg))
                break;
        }

        meet = NEW_PPERM2(deg);
        ptmeet2 = ADDR_PPERM2(meet);
        ptf2 = ADDR_PPERM2(f);
        ptg2 = ADDR_PPERM2(g);

        for (i = 0; i < deg; i++) {
            j = IMAGEPP(i + 1, ptf2, degf);
            if (IMAGEPP(i + 1, ptg2, degg) == j) {
                ptmeet2[i] = j;
                if (j > codeg)
                    codeg = j;
            }
        }
        SET_CODEG_PPERM2(meet, codeg);
    }
    else if (TNUM_OBJ(f) == T_PPERM4 && TNUM_OBJ(g) == T_PPERM2) {
        degf = DEG_PPERM4(f);
        degg = DEG_PPERM2(g);
        ptf4 = ADDR_PPERM4(f);
        ptg2 = ADDR_PPERM2(g);

        // find degree
        for (deg = (degf < degg ? degf : degg); deg > 0; deg--) {
            j = IMAGEPP(deg, ptf4, degf);
            if (j != 0 && j == IMAGEPP(deg, ptg2, degg))
                break;
        }

        meet = NEW_PPERM2(deg);
        ptmeet2 = ADDR_PPERM2(meet);
        ptf4 = ADDR_PPERM4(f);
        ptg2 = ADDR_PPERM2(g);

        for (i = 0; i < deg; i++) {
            j = IMAGEPP(i + 1, ptf4, degf);
            if (IMAGEPP(i + 1, ptg2, degg) == j) {
                ptmeet2[i] = j;
                if (j > codeg)
                    codeg = j;
            }
        }
        SET_CODEG_PPERM2(meet, codeg);
    }
    else if (TNUM_OBJ(f) == T_PPERM2 && TNUM_OBJ(g) == T_PPERM4) {
        degf = DEG_PPERM2(f);
        degg = DEG_PPERM4(g);
        ptf2 = ADDR_PPERM2(f);
        ptg4 = ADDR_PPERM4(g);

        // find degree
        for (deg = MIN(degf, degg); deg > 0; deg--) {
            j = IMAGEPP(deg, ptf2, degf);
            if (j != 0 && j == IMAGEPP(deg, ptg4, degg))
                break;
        }

        meet = NEW_PPERM2(deg);
        ptmeet2 = ADDR_PPERM2(meet);
        ptf2 = ADDR_PPERM2(f);
        ptg4 = ADDR_PPERM4(g);

        for (i = 0; i < deg; i++) {
            j = IMAGEPP(i + 1, ptf2, degf);
            if (IMAGEPP(i + 1, ptg4, degg) == j) {
                ptmeet2[i] = j;
                if (j > codeg)
                    codeg = j;
            }
        }
        SET_CODEG_PPERM2(meet, codeg);
    }
    else {
        degf = DEG_PPERM4(f);
        degg = DEG_PPERM4(g);
        ptf4 = ADDR_PPERM4(f);
        ptg4 = ADDR_PPERM4(g);

        // find degree
        for (deg = MIN(degf, degg); deg > 0; deg--) {
            j = IMAGEPP(deg, ptf4, degf);
            if (j != 0 && j == IMAGEPP(deg, ptg4, degg))
                break;
        }

        meet = NEW_PPERM4(deg);
        ptmeet4 = ADDR_PPERM4(meet);
        ptf4 = ADDR_PPERM4(f);
        ptg4 = ADDR_PPERM4(g);

        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;

    n = LEN_LIST(set);
    codeg = 0;

    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = DEG_PPERM2(f);
        ptf2 = ADDR_PPERM2(f);

        // 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;
    }
    else if (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);

    UInt2 *ptf2, *ptp2;
    UInt4 *ptf4, *ptp4;
    UInt   deg, i, j, rank;
    Obj    p, dom, img;

    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);

    UInt   deg, i, j, rank;
    Obj    perm, dom;
    UInt2 *ptf2, *ptp2, *ptg2;
    UInt4 *ptf4, *ptp4, *ptg4;

    if (TNUM_OBJ(f) == T_PPERM2) {
        deg = CODEG_PPERM2(f);
        rank = RANK_PPERM2(f);
        dom = DOM_PPERM(f);

        perm = NEW_PERM2(deg);
        ptp2 = ADDR_PERM2(perm);
        for (i = 0; i < deg; i++)
            ptp2[i] = i;
        ptf2 = ADDR_PPERM2(f);
        if (TNUM_OBJ(g) == T_PPERM2) {
            ptg2 = ADDR_PPERM2(g);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                ptp2[ptf2[j] - 1] = ptg2[j] - 1;
            }
        }
        else {
            ptg4 = ADDR_PPERM4(g);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                ptp2[ptf2[j] - 1] = ptg4[j] - 1;
            }
        }
    }
    else {
        deg = CODEG_PPERM4(f);
        rank = RANK_PPERM4(f);
        dom = DOM_PPERM(f);

        perm = NEW_PERM4(deg);
        ptp4 = ADDR_PERM4(perm);
        for (i = 0; i < deg; i++)
            ptp4[i] = i;
        ptf4 = ADDR_PPERM4(f);
        if (TNUM_OBJ(g) == T_PPERM2) {
            ptg2 = ADDR_PPERM2(g);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                ptp4[ptf4[j] - 1] = ptg2[j] - 1;
            }
        }
        else {
            ptg4 = ADDR_PPERM4(g);
            for (i = 1; i <= rank; i++) {
                j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
                ptp4[ptf4[j] - 1] = ptg4[j] - 1;
            }
        }
    }
    return perm;
}

static Obj FuncShortLexLeqPartialPerm(Obj self, Obj f, Obj g)
{
    UInt   rankf, rankg, i, j, k;
    Obj    domf, domg;
    UInt2 *ptf2, *ptg2;
    UInt4 *ptf4, *ptg4;

    RequirePartialPerm(SELF_NAME, f);
    RequirePartialPerm(SELF_NAME, g);

    if (TNUM_OBJ(f) == T_PPERM2) {
        if (DEG_PPERM2(f) == 0)
            return True;
        rankf = RANK_PPERM2(f);
        domf = DOM_PPERM(f);
    }
    else {
        if (DEG_PPERM4(f) == 0)
            return True;
        rankf = RANK_PPERM4(f);
        domf = DOM_PPERM(f);
    }

    if (TNUM_OBJ(g) == T_PPERM2) {
        if (DEG_PPERM2(g) == 0)
            return False;
        rankg = RANK_PPERM2(g);
        domg = DOM_PPERM(g);
    }
    else {
        if (DEG_PPERM4(g) == 0)
            return False;
        rankg = RANK_PPERM4(g);
        domg = DOM_PPERM(g);
    }

    if (rankf != rankg)
        return (rankf < rankg ? True : False);

    if (TNUM_OBJ(f) == T_PPERM2) {
        ptf2 = ADDR_PPERM2(f);
        if (TNUM_OBJ(g) == T_PPERM2) {
            ptg2 = ADDR_PPERM2(g);
            for (i = 1; i <= rankf; i++) {
                j = INT_INTOBJ(ELM_PLIST(domf, i)) - 1;
                k = INT_INTOBJ(ELM_PLIST(domg, i)) - 1;
                if (j != k)
                    return (j < k ? True : False);
                if (ptf2[j] != ptg2[j])
                    return (ptf2[j] < ptg2[j] ? True : False);
            }
        }
        else {
            ptg4 = ADDR_PPERM4(g);
            for (i = 1; i <= rankf; i++) {
                j = INT_INTOBJ(ELM_PLIST(domf, i)) - 1;
                k = INT_INTOBJ(ELM_PLIST(domg, i)) - 1;
                if (j != k)
                    return (j < k ? True : False);
                if (ptf2[j] != ptg4[j])
                    return (ptf2[j] < ptg4[j] ? True : False);
            }
        }
    }
    else {
        ptf4 = ADDR_PPERM4(f);
        if (TNUM_OBJ(g) == T_PPERM2) {
            ptg2 = ADDR_PPERM2(g);
            for (i = 1; i <= rankf; i++) {
                j = INT_INTOBJ(ELM_PLIST(domf, i)) - 1;
                k = INT_INTOBJ(ELM_PLIST(domg, i)) - 1;
                if (j != k)
                    return (j < k ? True : False);
                if (ptf4[j] != ptg2[j])
                    return (ptf4[j] < ptg2[j] ? True : False);
            }
        }
        else {
            ptg4 = ADDR_PPERM4(g);
            for (i = 1; i <= rankf; i++) {
                j = INT_INTOBJ(ELM_PLIST(domf, i)) - 1;
                k = INT_INTOBJ(ELM_PLIST(domg, i)) - 1;
                if (j != k)
                    return (j < k ? True : False);
                if (ptf4[j] != ptg4[j])
                    return (ptf4[j] < ptg4[j] ? True : False);
            }
        }
    }

    return False;
}

static Obj FuncHAS_DOM_PPERM(Obj self, Obj f)
{
    if (TNUM_OBJ(f) == T_PPERM2) {
        return (DOM_PPERM(f) == NULL ? False : True);
    }
    else if (TNUM_OBJ(f) == T_PPERM4) {
        return (DOM_PPERM(f) == NULL ? False : True);
    }
    return Fail;
}

static Obj FuncHAS_IMG_PPERM(Obj self, Obj f)
{
    if (TNUM_OBJ(f) == T_PPERM2) {
        return (IMG_PPERM(f) == NULL ? False : True);
    }
    else if (TNUM_OBJ(f) == T_PPERM4) {
        return (IMG_PPERM(f) == NULL ? False : True);
    }
    return Fail;
}

/**************************************************************************/

// GAP kernel functions

// an idempotent partial perm on the union of the domain and image
static Obj OnePPerm(Obj f)
{
    RequirePartialPerm("OnePPerm", f);

    Obj     g, img, dom;
    UInt    i, j, deg, rank;
    UInt2 * ptg2;
    UInt4 * ptg4;

    if (TNUM_OBJ(f) == T_PPERM2) {    // this could be shortened
        deg = MAX(DEG_PPERM2(f), CODEG_PPERM2(f));
        rank = RANK_PPERM2(f);
        dom = DOM_PPERM(f);
        img = IMG_PPERM(f);
    }
    else {
        deg = MAX(DEG_PPERM4(f), CODEG_PPERM4(f));
        rank = RANK_PPERM4(f);
        dom = DOM_PPERM(f);
        img = IMG_PPERM(f);
    }

    if (deg < 65536) {
        g = NEW_PPERM2(deg);
        ptg2 = ADDR_PPERM2(g);
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(img, i)) - 1;
            ptg2[j] = j + 1;
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            ptg2[j] = j + 1;
        }
        SET_CODEG_PPERM2(g, deg);
    }
    else {
        g = NEW_PPERM4(deg);
        ptg4 = ADDR_PPERM4(g);
        for (i = 1; i <= rank; i++) {
            j = INT_INTOBJ(ELM_PLIST(img, i)) - 1;
            ptg4[j] = j + 1;
            j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
            ptg4[j] = j + 1;
        }
        SET_CODEG_PPERM4(g, deg);
    }
    return g;
}

// equality for partial perms
template <typename TF, typename TG>
static Int EqPPerm(Obj f, Obj g)
{
    ASSERT_IS_PPERM<TF>(f);
    ASSERT_IS_PPERM<TG>(g);

    const TF * ptf = CONST_ADDR_PPERM<TF>(f);
    const TG * ptg = CONST_ADDR_PPERM<TG>(g);
    UInt    deg = DEG_PPERM<TF>(f);
    UInt    i, j, rank;
    Obj     dom;

    if (deg != DEG_PPERM<TG>(g) || CODEG_PPERM<TF>(f) != CODEG_PPERM<TG>(g))
        return 0;

    if (DOM_PPERM(f) == NULL || DOM_PPERM(g) == NULL) {
        for (i = 0; i < deg; i++)
            if (*ptf++ != *ptg++)
                return 0;
        return 1;
    }

    if (RANK_PPERM<TF>(f) != RANK_PPERM<TG>(g))
        return 0;
    dom = DOM_PPERM(f);
    rank = RANK_PPERM<TF>(f);

    for (i = 1; i <= rank; i++) {
        j = INT_INTOBJ(ELM_PLIST(dom, i)) - 1;
        if (ptf[j] != ptg[j])
            return 0;
    }
    return 1;
}

// less than for partial perms
template <typename TF, typename TG>
static Int LtPPerm(Obj f, Obj g)
{
    ASSERT_IS_PPERM<TF>(f);
    ASSERT_IS_PPERM<TG>(g);

    const TF * ptf = CONST_ADDR_PPERM<TF>(f);
    const TG * ptg = CONST_ADDR_PPERM<TG>(g);
    UInt    deg, i;

    deg = DEG_PPERM<TF>(f);
    if (deg != DEG_PPERM<TG>(g)) {
        if (deg < DEG_PPERM<TG>(g)) {
            return 1;
        }
        else {
            return 0;
        }
    }

    for (i = 0; i < deg; i++) {
        if (*(ptf++) != *(ptg++)) {
            if (*(--ptf) < *(--ptg))
                return 1;
            else
                return 0;
        }
    }
    return 0;
}

// product of partial perm and partial perm
template <typename TF, typename TG>
static Obj ProdPPerm(Obj f, Obj g)
{
    ASSERT_IS_PPERM<TF>(f);
    ASSERT_IS_PPERM<TG>(g);

    UInt    deg, degg, i, j, rank, codeg;
    const TF * ptf;
    const TG * ptg;
    TG *    ptfg;
    Obj     fg, dom;

    // find the degree
    deg = DEG_PPERM<TF>(f);
    degg = DEG_PPERM<TG>(g);
    if (deg == 0 || degg == 0)
        return EmptyPartialPerm;

    ptf = CONST_ADDR_PPERM<TF>(f);
    ptg = CONST_ADDR_PPERM<TG>(g);
    while (deg > 0 &&
           (ptf[deg - 1] == 0 || IMAGEPP(ptf[deg - 1], ptg, degg) == 0))
        deg--;
    if (deg == 0)
        return EmptyPartialPerm;

--> --------------------

--> maximum size reached

--> --------------------

quality89%

¤ Dauer der Verarbeitung: 0.45 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.