Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
71 changes: 60 additions & 11 deletions gap/basic/pcppcps.gi
Original file line number Diff line number Diff line change
Expand Up @@ -407,7 +407,8 @@ end );
## denominator of this pcp.
##
BindGlobal( "AddIgsToIgs", function( pcs1, pcs2 )
local coll, rels, n, inf, ind, todo, g, c, h, d, pair, t, val, j;
local coll, rels, n, inf, ind, todo, g, c, h, d, pair, t, val, j,
a, b, changed, reduced, oldc, chg, i, pows, q;

if Length( pcs1 ) = 0 then
return AsList( pcs2 );
Expand All @@ -419,13 +420,18 @@ BindGlobal( "AddIgsToIgs", function( pcs1, pcs2 )
return Concatenation( AsList( pcs2 ), AsList( pcs1 ) );
fi;

# merge the two pcs'
# get information
coll := Collector( pcs1[1] );
rels := RelativeOrders( coll );
n := NumberOfGenerators( coll );
inf := 0 in rels;
ind := List( [1..n], x -> false );

# set up; pows[d] caches negative powers of ind[d]
ind := ListWithIdenticalEntries(n, false);
pows := [];
todo := [];

# merge the two pcs'
for g in pcs2 do ind[Depth(g)] := g; od;
for g in pcs1 do
if IsBool( ind[Depth(g)] ) then
Expand All @@ -435,36 +441,79 @@ BindGlobal( "AddIgsToIgs", function( pcs1, pcs2 )
fi;
od;

# set counter
# do a reduction step
c := TailLimit(ind, n+1);
todo := Filtered( todo, x -> Depth( x ) < c );
val := List(todo, IGSValFun);

# initial todo entries still need to be reduced
reduced := false;

# loop over to-do list until it is empty
while Length( todo ) > 0 and c > 1 do
j := PositionMinimum(val);
g := Remove(todo, j);
Remove(val, j);
d := Depth( g );
changed := false;

# shift g into ind
while d < c do
h := ind[d];
if not IsBool( h ) then
# adjust g and ind[d] by gcd
pair := GcdPcp( ind[d], g );
ind[d] := pair[1];
g := pair[2];
a := LeadingExponent(g);
b := LeadingExponent(h);
if g = h and b > 0 then
g := g^0;
elif a > 0 and b > 0 and a mod b = 0 then
# GcdPcp is not needed since b divides a.
q := SmallestResidue(a/b, rels[d]);
g := g * IgsNegativePower(ind, pows, d, q);
else
pair := GcdPcp(h, g);
if pair[1] <> h then
ind[d] := pair[1];
Unbind(pows[d]);
changed := true;
fi;
g := pair[2];
fi;
else
ind[d] := g;
Unbind(pows[d]);
g := g^0;
changed := true;
fi;
d := Depth( g );
od;

# ind unchanged and every todo entry already reduced, so ReduceExpo,
# TailLimit and the filter would be no-ops
if not changed and reduced then continue; fi;

# adjust
oldc := c;
c := TailLimit(ind, c);
if inf then ReduceExpo(ind, todo, rels, []); fi;
todo := Filtered(todo, x -> Depth(x)<c);
val := List(todo, IGSValFun);
chg := [];
if inf then
t := ReduceExpo(ind, todo, rels, pows);
for i in t[1] do Unbind(pows[i]); od;
chg := t[2];
fi;
reduced := true;
for i in chg do
if Depth(todo[i]) < c then val[i] := IGSValFun(todo[i]); fi;
od;

# reduce
if c < oldc or Length(chg) > 0 then
t := Filtered([1..Length(todo)], i -> Depth(todo[i]) < c);
todo := todo{t};
val := val{t};
fi;
od;

# return resulting list
ind := Filtered( ind, x -> not IsBool( x ) );
if POLYCYCLIC_CHECK_IGS then
Info(InfoPcpGrp, 1, "checking igs ");
Expand Down
85 changes: 65 additions & 20 deletions gap/pcpgrp/inters.gi
Original file line number Diff line number Diff line change
Expand Up @@ -5,11 +5,13 @@

# Based on ReduceExpoPara, but with IsOne instead of IsBool, and adapted to
# the NormalIntersection algorithm
BindGlobal( "ReduceExpoParaInt", function( ind, indd, gen, rel )
local n, changed, i, j, c, g, a, b, q;
# Returns the positions changed in ind and indd, and in gen.
BindGlobal( "ReduceExpoParaInt", function( ind, indd, gen, rel, pows, ppows )
local n, changed, cg, i, j, c, g, a, b, q;

n := Length(rel);
changed := [];
cg := [];
for i in [1..Length(ind)] do
if i <= n then
c := i;
Expand All @@ -29,8 +31,8 @@ BindGlobal( "ReduceExpoParaInt", function( ind, indd, gen, rel )
fi;
q := QuoInt(a,b);
if q <> 0 then
ind[j] := ind[j]*ind[i]^-q;
indd[j] := indd[j]*indd[i]^-q;
ind[j] := ind[j]*IgsNegativePower(ind, pows, i, q);
indd[j] := indd[j]*IgsNegativePower(indd, ppows, i, q);
AddSet(changed, j);
fi;
fi;
Expand All @@ -43,13 +45,14 @@ BindGlobal( "ReduceExpoParaInt", function( ind, indd, gen, rel )
fi;
q := QuoInt(a,b);
if q <> 0 then
gen[j][1] := gen[j][1]*ind[i]^-q;
gen[j][2] := gen[j][2]*indd[i]^-q;
gen[j][1] := gen[j][1]*IgsNegativePower(ind, pows, i, q);
gen[j][2] := gen[j][2]*IgsNegativePower(indd, ppows, i, q);
AddSet(cg, j);
fi;
od;
fi;
od;
return changed;
return [changed, cg];
end );

#############################################################################
Expand All @@ -69,10 +72,12 @@ InstallMethod( NormalIntersection, "for pcp groups",
function( N, U )
local coll, rels, igsN, igsU, n, s, todo, I, id, ls, rs, g, h, k, d,
al, ar, e, tm, pairs, changed, j, lo, hi, loDep, hiDep, value,
depth, c;
depth, c, inf, val, oldc, reduced, chg, i, sub, lpows, rpows;

# get information
coll := Collector( N );
rels := RelativeOrders( coll );
inf := 0 in rels;

igsN := Cgs( N );
igsU := Cgs( U );
Expand Down Expand Up @@ -109,9 +114,13 @@ function( N, U )

# Igs of subgroup generated by (u,u)'s and (n,1)'s in G x G
# rows (1,u) then give the intersection N ∩ U

# set up; lpows[d] and rpows[d] cache negative powers of ls[d] and rs[d]
id := One(N);
ls := ListWithIdenticalEntries(2*n, id);
rs := ListWithIdenticalEntries(2*n, id);
lpows := [];
rpows := [];
c := 2*n+1;

for g in igsU do
Expand Down Expand Up @@ -139,14 +148,18 @@ function( N, U )
return [-1, 0];
fi;
end;
val := List(todo, value);

# enter the pairs of todo
# loop over to-do list until it is empty
while not IsEmpty(todo) and c > 1 do
tm := Remove(todo, PositionMinimum(todo, value));
j := PositionMinimum(val);
tm := Remove(todo, j);
Remove(val, j);
al := tm[1];
ar := tm[2];
changed := [];

# shift the pair into ls and rs
while al <> id or ar <> id do
if al <> id then
d := Depth( al );
Expand All @@ -163,6 +176,8 @@ function( N, U )
e := NormingExponent(g);
ls[d] := al ^ e;
rs[d] := ar ^ e;
Unbind(lpows[d]);
Unbind(rpows[d]);
AddSet(changed, d);
if d <= n then
h := ls[d];
Expand All @@ -175,40 +190,45 @@ function( N, U )
al := id;
ar := id;
elif LeadingExponent(g) mod LeadingExponent(h) = 0 then
e := LeadingExponent(g) / LeadingExponent(h);
s := d;
if s > n then s := s-n; fi;
e := SmallestResidue(LeadingExponent(g) / LeadingExponent(h),
rels[s]);
if e = 1 and al = ls[d] then
al := id;
elif ls[d] <> id then
al := al * ls[d] ^ -e;
al := al * IgsNegativePower(ls, lpows, d, e);
fi;
if e = 1 and ar = rs[d] then
ar := id;
elif rs[d] <> id then
ar := ar * rs[d] ^ -e;
ar := ar * IgsNegativePower(rs, rpows, d, e);
fi;
elif d <= n then
pairs := GcdPcpPara( ls[d], al, rs[d], ar );
ls[d] := pairs[1];
al := pairs[2];
rs[d] := pairs[3];
ar := pairs[4];
Unbind(lpows[d]);
Unbind(rpows[d]);
AddSet(changed, d);
else
pairs := GcdPcp(rs[d], ar);
rs[d] := pairs[1];
ar := pairs[2];
Unbind(rpows[d]);
AddSet(changed, d);
fi;
od;

# ls and rs unchanged, so skip adjustment, powers and commutators
if IsEmpty(changed) then
continue;
fi;
if 0 in rels then
UniteSet(changed, ReduceExpoParaInt(ls, rs, todo, rels));
fi;

# if tail is complete, remove corresponding things in todo
# adjust
oldc := c;
while c > 1 do
if c-1 <= n then
g := ls[c-1];
Expand All @@ -220,10 +240,23 @@ function( N, U )
fi;
c := c-1;
od;
todo := Filtered(todo, pair -> depth(pair) < c);
chg := [];
if inf then
reduced := ReduceExpoParaInt(ls, rs, todo, rels, lpows, rpows);
for i in reduced[1] do
Unbind(lpows[i]);
Unbind(rpows[i]);
od;
UniteSet(changed, reduced[1]);
chg := reduced[2];
for i in chg do
if depth(todo[i]) < c then val[i] := value(todo[i]); fi;
od;
fi;

# add powers and commutators
for d in changed do
# skip infinite factors and powers in the tail
if d < c-1 then
if d <= n then
g := ls[d];
Expand All @@ -235,10 +268,12 @@ function( N, U )
tm := [ls[d] ^ e, rs[d] ^ e];
if depth(tm) < c then
Add(todo, tm);
Add(val, value(tm));
fi;
fi;
fi;
for j in [1..2*n] do
# skip repeated or trivial commutators and those in the tail
if j = d or (j < d and j in changed) or
Minimum(d, j) >= c-1 or
(ls[j] = id and rs[j] = id) then continue; fi;
Expand Down Expand Up @@ -272,6 +307,7 @@ function( N, U )
tm := [al, ar];
if depth(tm) < c then
Add(todo, tm);
Add(val, value(tm));
fi;
if lo <= n then
g := ls[lo];
Expand All @@ -282,20 +318,29 @@ function( N, U )
# if [ h, g ] = 1, then also [ h, g^-1 ] = 1
# so skip if [ h, g ] = 1 is known already
if al <> id then
al := Comm(ls[hi], ls[lo] ^ -1);
al := Comm(ls[hi], IgsNegativePower(ls, lpows, lo, 1));
fi;
if ar <> id then
ar := Comm(rs[hi], rs[lo] ^ -1);
ar := Comm(rs[hi], IgsNegativePower(rs, rpows, lo, 1));
fi;
tm := [al, ar];
if depth(tm) < c then
Add(todo, tm);
Add(val, value(tm));
fi;
fi;
od;
od;

# reduce
if c < oldc or not IsEmpty(chg) then
sub := Filtered([1..Length(todo)], i -> depth(todo[i]) < c);
todo := todo{sub};
val := val{sub};
fi;
od;

# return resulting subgroup
I := Filtered(rs{[n+1..2*n]}, x -> x <> id);
return SubgroupByIgs( N, I );
end );
Expand Down
Loading