From c4482be069ae5f9f24b8dc7b740df412b2899527 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Wed, 10 Jan 2024 10:16:17 +0100 Subject: [PATCH] Add argument validation to `ListPerm`, and turn it into a kernel function to make it faster (#5566) --- lib/permutat.g | 27 +++------- src/listfunc.c | 10 ++-- src/permutat.cc | 104 +++++++++++++++++++++++++++++++++++---- tst/testinstall/perm.tst | 48 ++++++++++++++++++ 4 files changed, 153 insertions(+), 36 deletions(-) diff --git a/lib/permutat.g b/lib/permutat.g index e0b551532b..e7caa2d335 100644 --- a/lib/permutat.g +++ b/lib/permutat.g @@ -444,39 +444,26 @@ SetOne( PermutationsFamily, () ); ############################################################################# ## -#F ListPerm( [, ] ) . . . . . . . . . . . . . list of images +#F ListPerm( [, ] ) . . . . . . . . . . . . . list of images ## ## <#GAPDoc Label="ListPerm"> ## -## +## ## ## ## is a list l that contains the images of the positive integers -## under the permutation perm. +## from 1 to n under the permutation perm. ## That means that ## l[i] = i^perm, -## where i lies between 1 -## and the largest point moved by perm -## (see ). +## where i lies between 1 and n. ##

-## An optional second argument specifies the length of the desired list. +## If the optional second argument n is omitted then the largest +## point moved by perm is used +## (see ). ## ## ## <#/GAPDoc> ## -BIND_GLOBAL( "ListPerm", function( arg ) - local n; - if Length(arg)=2 then - n := arg[2]; - else - n := LargestMovedPoint(arg[1]); - fi; - if IsOne(arg[1]) then - return [1..n]; - else - return OnTuples( [1..n], arg[1] ); - fi; -end ); ############################################################################# diff --git a/src/listfunc.c b/src/listfunc.c index 99e424f885..f8db3922b6 100644 --- a/src/listfunc.c +++ b/src/listfunc.c @@ -1528,15 +1528,13 @@ static Int InitKernel ( StructInitInfo * module ) { // init filters and functions - /* ADD_LIST needs special consideration because we want distinct kernel - handlers for 2 and 3 arguments */ - InitHandlerFunc( FuncADD_LIST, "src/listfunc.c:FuncADD_LIST" ); - InitHandlerFunc( FuncADD_LIST3, "src/listfunc.c:FuncADD_LIST3" ); - InitHdlrOpersFromTable( GVarOpers ); InitHdlrFuncsFromTable( GVarFuncs ); - + // ADD_LIST needs special consideration because we want distinct kernel + // handlers for 2 and 3 arguments + InitHandlerFunc( FuncADD_LIST, "src/listfunc.c:FuncADD_LIST" ); + InitHandlerFunc( FuncADD_LIST3, "src/listfunc.c:FuncADD_LIST3" ); return 0; } diff --git a/src/permutat.cc b/src/permutat.cc index e88a7fb2aa..e6d2cbfbda 100644 --- a/src/permutat.cc +++ b/src/permutat.cc @@ -1098,6 +1098,63 @@ static Obj FuncPermList(Obj self, Obj list) } } +template +static inline Obj ListPerm_(Obj perm, Int len) +{ + Obj res; // handle of the image, result + Obj * ptRes; // pointer to the result + const T * ptPrm; // pointer to the permutation + UInt deg; // degree of the permutation + UInt i; // loop variable + + if (len <= 0) + return NewEmptyPlist(); + + // copy the list into a mutable plist, which we will then modify in place + res = NEW_PLIST(T_PLIST_CYC, len); + SET_LEN_PLIST(res, len); + + // get the pointer + ptRes = ADDR_OBJ(res) + 1; + ptPrm = CONST_ADDR_PERM(perm); + + // loop over the entries of the permutation + deg = DEG_PERM(perm); + if (deg > len) + deg = len; + for (i = 1; i <= deg; i++, ptRes++) { + *ptRes = INTOBJ_INT(ptPrm[i - 1] + 1); + } + // add extras if requested + for (; i <= len; i++, ptRes++) { + *ptRes = INTOBJ_INT(i); + } + + return res; +} + +static Obj ListPermOper; + +static Obj FuncListPerm1(Obj self, Obj perm) +{ + RequirePermutation(SELF_NAME, perm); + Int nn = LargestMovedPointPerm(perm); + if (TNUM_OBJ(perm) == T_PERM2) + return ListPerm_(perm, nn); + else + return ListPerm_(perm, nn); +} + +static Obj FuncListPerm2(Obj self, Obj perm, Obj n) +{ + RequirePermutation(SELF_NAME, perm); + Int nn = GetSmallInt(SELF_NAME, n); + if (TNUM_OBJ(perm) == T_PERM2) + return ListPerm_(perm, nn); + else + return ListPerm_(perm, nn); +} + /**************************************************************************** ** *F LargestMovedPointPerm( ) largest point moved by perm @@ -1951,9 +2008,9 @@ static inline Obj SMALLEST_IMG_TUP_PERM(Obj tup, Obj perm) { UInt res; // handle of the image, result const Obj * ptTup; // pointer to the tuple - const T * ptPrm; // pointer to the permutation + const T * ptPrm; // pointer to the permutation UInt tmp; // temporary handle - UInt lmp; // largest moved point + UInt deg; // degree of the permutation UInt i, k; // loop variables res = MAX_DEG_PERM4; // ``infty''. @@ -1961,12 +2018,12 @@ static inline Obj SMALLEST_IMG_TUP_PERM(Obj tup, Obj perm) // get the pointer ptTup = CONST_ADDR_OBJ(tup) + LEN_LIST(tup); ptPrm = CONST_ADDR_PERM(perm); - lmp = DEG_PERM(perm); + deg = DEG_PERM(perm); // loop over the entries of the tuple for ( i = LEN_LIST(tup); 1 <= i; i--, ptTup-- ) { k = INT_INTOBJ( *ptTup ); - if ( k <= lmp ) + if ( k <= deg ) tmp = ptPrm[k-1] + 1; else tmp = k; @@ -2004,7 +2061,7 @@ static inline Obj OnTuplesPerm_(Obj tup, Obj perm) Obj * ptRes; // pointer to the result const T * ptPrm; // pointer to the permutation Obj tmp; // temporary handle - UInt lmp; // largest moved point + UInt deg; // degree of the permutation UInt i, k; // loop variables // copy the list into a mutable plist, which we will then modify in place @@ -2016,14 +2073,14 @@ static inline Obj OnTuplesPerm_(Obj tup, Obj perm) // get the pointer ptRes = ADDR_OBJ(res) + 1; ptPrm = CONST_ADDR_PERM(perm); - lmp = DEG_PERM(perm); + deg = DEG_PERM(perm); // 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 <= lmp) { + if (k <= deg) { *ptRes = INTOBJ_INT(ptPrm[k - 1] + 1); } } @@ -2073,7 +2130,7 @@ static inline Obj OnSetsPerm_(Obj set, Obj perm) Obj * ptRes; // pointer to the result const T * ptPrm; // pointer to the permutation Obj tmp; // temporary handle - UInt lmp; // largest moved point + UInt deg; // degree of the permutation UInt i, k; // loop variables // copy the list into a mutable plist, which we will then modify in place @@ -2083,7 +2140,7 @@ static inline Obj OnSetsPerm_(Obj set, Obj perm) // get the pointer ptRes = ADDR_OBJ(res) + 1; ptPrm = CONST_ADDR_PERM(perm); - lmp = DEG_PERM(perm); + deg = DEG_PERM(perm); // loop over the entries of the tuple BOOL isSmallIntList = TRUE; @@ -2091,7 +2148,7 @@ static inline Obj OnSetsPerm_(Obj set, Obj perm) tmp = *ptRes; if (IS_POS_INTOBJ(tmp)) { k = INT_INTOBJ(tmp); - if (k <= lmp) { + if (k <= deg) { *ptRes = INTOBJ_INT(ptPrm[k - 1] + 1); } } @@ -2744,6 +2801,22 @@ static StructGVarFilt GVarFilts[] = { }; + +/**************************************************************************** +** +*V GVarOpers . . . . . . . . . . . . . . . . . list of operations to export +*/ +static StructGVarOper GVarOpers [] = { + + // ListPerm can take 1 or 2 arguments; since NewOperation ignores the + // handler for variadic operations, use DoOperation0Args as a placeholder. + { "ListPerm", -1, "perm[, n]", &ListPermOper, + (ObjFunc)DoOperation0Args, "src/permutat.cc:ListPerm" }, + + { 0, 0, 0, 0, 0, 0 } + +}; + /**************************************************************************** ** *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export @@ -2817,8 +2890,14 @@ static Int InitKernel ( // init filters and functions InitHdlrFiltsFromTable( GVarFilts ); + InitHdlrOpersFromTable( GVarOpers ); InitHdlrFuncsFromTable( GVarFuncs ); + // ListPerm needs special consideration because we want distinct kernel + // handlers for 1 and 2 arguments + InitHandlerFunc( (ObjFunc)FuncListPerm1, "src/permutat.cc:FuncListPerm1" ); + InitHandlerFunc( (ObjFunc)FuncListPerm2, "src/permutat.cc:FuncListPerm2" ); + // make the buffer bag #ifndef HPCGAP InitGlobalBag( &TmpPerm, "src/permutat.cc:TmpPerm" ); @@ -2924,8 +3003,13 @@ static Int InitLibrary ( { // init filters and functions InitGVarFiltsFromTable( GVarFilts ); + InitGVarOpersFromTable( GVarOpers ); InitGVarFuncsFromTable( GVarFuncs ); + // make and install the 'ListPerm' operation + SET_HDLR_FUNC( ListPermOper, 1, (ObjFunc)FuncListPerm1); + SET_HDLR_FUNC( ListPermOper, 2, (ObjFunc)FuncListPerm2); + // make the identity permutation IdentityPerm = NEW_PERM2(0); diff --git a/tst/testinstall/perm.tst b/tst/testinstall/perm.tst index 295af000f6..8bec0a532a 100644 --- a/tst/testinstall/perm.tst +++ b/tst/testinstall/perm.tst @@ -286,6 +286,54 @@ gap> SetX(permAll, permAll, {a,b} -> Comm(a,b) = LeftQuotient((b*a), a*b)); # gap> SetX(permAll, permAll, {a,b} -> a * Comm(a,b) = a^b); # [ true ] +# +# ListPerm +# +gap> p := (); +() +gap> ListPerm( p ); +[ ] +gap> List([-1,0,1,5], n -> ListPerm( p, n )); +[ [ ], [ ], [ 1 ], [ 1, 2, 3, 4, 5 ] ] + +# +gap> p := (1,100) / (1,100); +() +gap> ListPerm( p ); +[ ] +gap> List([-1,0,1,5], n -> ListPerm( p, n )); +[ [ ], [ ], [ 1 ], [ 1, 2, 3, 4, 5 ] ] + +# +gap> p := (1,2^17) / (1,2^17); +() +gap> ListPerm( p ); +[ ] +gap> List([-1,0,1,5], n -> ListPerm( p, n )); +[ [ ], [ ], [ 1 ], [ 1, 2, 3, 4, 5 ] ] + +# +gap> p := (1,2,3); +(1,2,3) +gap> ListPerm( p ); +[ 2, 3, 1 ] +gap> List([-1,0,1,5], n -> ListPerm( p, n )); +[ [ ], [ ], [ 2 ], [ 2, 3, 1, 4, 5 ] ] + +# +gap> p := (1,2,3,10000)*(1,10000); +(1,2,3) +gap> ListPerm( p ); +[ 2, 3, 1 ] +gap> List([-1,0,1,5], n -> ListPerm( p, n )); +[ [ ], [ ], [ 2 ], [ 2, 3, 1, 4, 5 ] ] + +# +gap> ListPerm( 1 ); +Error, ListPerm: must be a permutation (not the integer 1) +gap> ListPerm( (1,2,3), "bla" ); +Error, ListPerm: must be a small integer (not a list (string)) + # # PermList #