diff --git a/gap/basic/pcppcps.gi b/gap/basic/pcppcps.gi index 1623cc0..8433da6 100644 --- a/gap/basic/pcppcps.gi +++ b/gap/basic/pcppcps.gi @@ -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 ); @@ -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 @@ -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) 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 "); diff --git a/gap/pcpgrp/inters.gi b/gap/pcpgrp/inters.gi index 0f12a87..dbc8af5 100644 --- a/gap/pcpgrp/inters.gi +++ b/gap/pcpgrp/inters.gi @@ -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; @@ -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; @@ -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 ); ############################################################################# @@ -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 ); @@ -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 @@ -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 ); @@ -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]; @@ -175,16 +190,19 @@ 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 ); @@ -192,23 +210,25 @@ function( N, U ) 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]; @@ -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]; @@ -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; @@ -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]; @@ -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 );