691 lines
26 KiB
Plaintext
691 lines
26 KiB
Plaintext
#############################################################################
|
|
##
|
|
#W iso.gi Isomorphisms and isotopisms [loops]
|
|
##
|
|
#H @(#)$Id: iso.gi, v 3.3.0 2016/10/26 gap Exp $
|
|
##
|
|
#Y Copyright (C) 2004, G. P. Nagy (University of Szeged, Hungary),
|
|
#Y P. Vojtechovsky (University of Denver, USA)
|
|
##
|
|
|
|
#############################################################################
|
|
## DISCRIMINATOR
|
|
## -------------------------------------------------------------------------
|
|
|
|
#############################################################################
|
|
##
|
|
#O Discriminator( Q )
|
|
##
|
|
## Returns the dicriminator of a quasigroup <Q>.
|
|
## It is a list [ A, B ], where A is a list of the form
|
|
## [ [I1,n1], [I2,n2],.. ], where the invariant Ii occurs ni times in Q,
|
|
## and where B[i] is a subset of [1..Size(Q)] corresponding to elements of
|
|
## Q with invariant Ii.
|
|
##
|
|
## PROG: Invariants 8, 9 can be slow for large quasigroups.
|
|
|
|
InstallMethod( Discriminator, "for quasigroup",
|
|
[ IsQuasigroup ],
|
|
function( Q )
|
|
local n, T, I, case, i, j, k, ebo, js, ks, count1, count2, A, P, B, perm, p;
|
|
|
|
# making sure the quasigroup is canonical
|
|
if not Q = Parent( Q ) then Q := CanonicalCopy( Q ); fi;
|
|
n := Size( Q );
|
|
|
|
# converting a non-declared loop into a loop
|
|
perm := ();
|
|
if (not IsLoop( Q )) and (not MultiplicativeNeutralElement( Q )=fail) then
|
|
p := Position( Elements( Q ), MultiplicativeNeutralElement( Q ) );
|
|
if p<>1 then
|
|
perm := (1,p);
|
|
fi;
|
|
Q := IntoLoop( Q );
|
|
fi;
|
|
|
|
T := CayleyTable( Q );
|
|
|
|
# Calculating 9 invariants for three cases: quasigroup, loop, power associative loop
|
|
# I[i] will contain the invariant vector for ith element of Q
|
|
I := List( [1..n], i -> 0*[1..9] );
|
|
|
|
# invariant 1
|
|
# to distinguish the 3 cases
|
|
if (not IsLoop( Q ) )
|
|
then case := 1;
|
|
elif (not IsPowerAssociative( Q ))
|
|
then case := 2;
|
|
else
|
|
case := 3;
|
|
fi;
|
|
for i in [1..n] do I[i][1] := case; od;
|
|
|
|
# invariant 2
|
|
# for given x, cycle structure of L_x, R_x
|
|
for i in [1..n] do
|
|
I[i][2] := [
|
|
CycleStructurePerm( PermList( List( [1..n], j -> T[i][j]) ) ),
|
|
CycleStructurePerm( PermList( List( [1..n], j -> T[j][i]) ) )
|
|
];
|
|
od;
|
|
|
|
# invariant 3
|
|
if case = 1 then # am I an idempotent?
|
|
for i in [1..n] do I[i][3] := T[i][i]=i; od;
|
|
elif case = 2 then # am I an involution?
|
|
for i in [1..n] do I[i][3] := T[i][i]=1; od;
|
|
else # what's my order?
|
|
for i in [1..n] do I[i][3] := Order( Elements( Q )[i] ); od;
|
|
fi;
|
|
|
|
# invariant 4
|
|
if case <> 3 then # how many times am I a square ?
|
|
for i in [1..n] do j := T[i][i]; I[j][4] := I[j][4] + 1; od;
|
|
else # how many times am I a square, third power, fourth power?
|
|
for i in [1..n] do I[i][4] := [0,0,0]; od;
|
|
for i in [1..n] do
|
|
j := T[i][i]; I[j][4][1] := I[j][4][1] + 1;
|
|
j := T[i][j]; I[j][4][2] := I[j][4][2] + 1;
|
|
j := T[i][j]; I[j][4][3] := I[j][4][3] + 1;
|
|
od;
|
|
fi;
|
|
|
|
# invariant 5
|
|
if case <> 3 then # with how many elements do I commute?
|
|
for i in [1..n] do
|
|
I[i][5] := Length( Filtered( [1..n], j -> T[i][j] = T[j][i] ) );
|
|
od;
|
|
else # with how many elements of given order do I commute?
|
|
ebo := List( [1..n], i -> Filtered( [1..n], j -> I[j][3]=i ) ); # elements by order. PROG: must point to order invariant
|
|
ebo := Filtered( ebo, x -> not IsEmpty( x ) );
|
|
for i in [1..n] do
|
|
I[i][5] := List( ebo, J -> Length( Filtered( J, j -> T[ i ][ j ] = T[ j ][ i ] ) ) );
|
|
od;
|
|
fi;
|
|
|
|
# invariant 6
|
|
# is it true that (x*x)*x = x*(x*x)?
|
|
for i in [1..n] do
|
|
I[i][6] := T[T[i][i]][i] = T[i][T[i][i]];
|
|
od;
|
|
|
|
# invariant 7
|
|
if case <> 3 then # for how many elements y is (x*x)*y = x*(x*y)?
|
|
for i in [1..n] do
|
|
I[i][7] := Length( Filtered( [1..n], j -> T[T[i][i]][j] = T[i][T[i][j]] ) );
|
|
od;
|
|
else # for how many elements y of given order is (x*x)*y=x*(x*y)
|
|
for i in [1..n] do
|
|
I[i][7] := List( ebo, J -> Length( Filtered( J, j -> T[T[i][i]][j] = T[i][T[j][i]] ) ) );
|
|
od;
|
|
fi;
|
|
|
|
# invariants 8 and 9 (these take longer)
|
|
if case <> 3 then # with how many pairs of elements do I associate in the first, second position?
|
|
for i in [1..n] do
|
|
for j in [1..n] do for k in [1..n] do
|
|
if T[i][T[j][k]] = T[T[i][j]][k] then I[i][8] := I[i][8] + 1; fi;
|
|
if T[j][T[i][k]] = T[T[j][i]][k] then I[i][9] := I[i][9] + 1; fi;
|
|
od; od;
|
|
od;
|
|
else # for how many pairs of elements of given orders do I associate in the first, second position?
|
|
for i in [1..n] do
|
|
I[i][8] := []; I[i][9] := [];
|
|
for js in ebo do for ks in ebo do
|
|
count1 := 0; count2 := 0;
|
|
for j in js do for k in ks do
|
|
if T[i][T[j][k]] = T[T[i][j]][k] then count1 := count1 + 1; fi;
|
|
if T[j][T[i][k]] = T[T[j][i]][k] then count2 := count2 + 1; fi;
|
|
od; od;
|
|
Add( I[i][8], count1 ); Add( I[i][9], count2 );
|
|
od; od;
|
|
od;
|
|
fi;
|
|
|
|
# all invariants have now been calculated
|
|
|
|
# note that it can be deduced from the invariants when an element is central, for instance
|
|
|
|
# setting up the first part of the discriminator (invariants with the number of occurence)
|
|
A := Collected( I );
|
|
P := Sortex( List( A, x -> x[2] ) ); # rare invariants will be listed first, but the set ordering of A is otherwise not disrupted
|
|
A := Permuted( A, P );
|
|
|
|
# setting up the second part of the discriminator (blocks of elements invariant under isomorphisms)
|
|
B := List( [1..Length(A)], j -> Filtered( [1..n], i -> I[i] = A[j][1] ) );
|
|
|
|
# if a non-declared loop was converted into a loop, correcting for this
|
|
if not perm = () then
|
|
B := List( B, x -> Set( x, i -> i^perm ) );
|
|
fi;
|
|
|
|
return [ A, B ];
|
|
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#F LOOPS_EfficientGenerators( Q, D )
|
|
##
|
|
## Auxiliary function.
|
|
## Given a quasigroup <Q> with discriminator <D>, it returns a list of
|
|
## indices of generators of <Q> deemed best for an isomorphism filter.
|
|
## It mimics the function SmallGeneratingSet, but it considers
|
|
## the elements in order determined by block size of the disciminator.
|
|
|
|
InstallGlobalFunction( LOOPS_EfficientGenerators,
|
|
function( Q, D )
|
|
local gens, sub, elements, candidates, max, S, best_gen, best_S;
|
|
|
|
gens := []; # generating set to be returned
|
|
sub := []; # substructure generated so far
|
|
elements := Concatenation( D[2] ); # all elements ordered by block size
|
|
candidates := ShallowCopy( elements ); # candidates for next generator
|
|
while sub <> Q do
|
|
# find an element not in sub that most enlarges sub
|
|
max := 0;
|
|
while not IsEmpty( candidates ) do
|
|
S := Subquasigroup( Q, Union( gens, [candidates[1]] ) );
|
|
if Size(S) > max then
|
|
max := Size( S );
|
|
best_gen := candidates[1];
|
|
best_S := S;
|
|
fi;
|
|
# discard elements of S since they cannot do better
|
|
candidates := Filtered( candidates, x -> not Elements(Q)[x] in S );
|
|
od;
|
|
Add( gens, best_gen );
|
|
sub := best_S;
|
|
# reset candidates for next round
|
|
candidates := Filtered( elements, x -> not Elements(Q)[x] in sub );
|
|
od;
|
|
return gens;
|
|
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#O AreEqualDicriminators( D, E )
|
|
##
|
|
## Returns true if the invarinats of the two discriminators are the same,
|
|
## including number of occurrences of each invariant.
|
|
|
|
InstallMethod( AreEqualDiscriminators, "for two lists (discrimninators)",
|
|
[ IsList, IsList ],
|
|
function( D, E )
|
|
return D[ 1 ] = E[ 1 ];
|
|
end);
|
|
|
|
#############################################################################
|
|
## EXTENDING MAPPINS (AUXILIARY)
|
|
## -------------------------------------------------------------------------
|
|
|
|
# Here, we identity the map f: A --> B with the triple [ m, a, b ],
|
|
# where a is a subset of A, b[ i ] is the image of a[ i ], and m[ i ] > 0
|
|
# if and only if i is in a.
|
|
|
|
#############################################################################
|
|
##
|
|
#F LOOPS_ExtendHomomorphismByClosingSource( f, L, M )
|
|
##
|
|
## Auxiliary.
|
|
## <L>, <M> are multiplication tables of quasigroups, <f> is a partial map
|
|
## from a subset of elements of <L> to a subset of elements of <M>.
|
|
## This function attempts to extend <f> into a homomorphism of quasigroups by
|
|
## extending the source of <f> into (the smallest possible) subqusigroup of <L>.
|
|
|
|
InstallGlobalFunction( LOOPS_ExtendHomomorphismByClosingSource,
|
|
function( f, L, M )
|
|
local oldS, newS, pairs, x, y, newNow, p, z, fz;
|
|
oldS := [ ];
|
|
newS := f[ 2 ];
|
|
|
|
repeat
|
|
pairs := [];
|
|
for x in oldS do for y in newS do
|
|
Add( pairs, [ x, y ] );
|
|
Add( pairs, [ y, x ] );
|
|
od; od;
|
|
for x in newS do for y in newS do
|
|
Add( pairs, [ x, y ] );
|
|
od; od;
|
|
newNow := [];
|
|
for p in pairs do
|
|
x := p[ 1 ];
|
|
y := p[ 2 ];
|
|
z := L[ x ][ y ];
|
|
fz := M[ f[ 1 ][ x ] ][ f[ 1 ][ y ] ];
|
|
if f[ 1 ][ z ] = 0 then
|
|
f[ 1 ][ z ] := fz; AddSet( f[ 2 ], z ); AddSet( f[ 3 ], fz );
|
|
Add( newNow, z );
|
|
else
|
|
if not f[ 1 ][ z ] = fz then return fail; fi;
|
|
fi;
|
|
od;
|
|
oldS := Union( oldS, newS );
|
|
newS := ShallowCopy( newNow );
|
|
until IsEmpty( newS );
|
|
return f;
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#F LOOPS_SublistPosition( S, x )
|
|
##
|
|
## auxiliary function
|
|
## input: list of lists <S>, element <x>
|
|
## returns: smallest i such that x in S[i]; or fail.
|
|
|
|
InstallGlobalFunction( LOOPS_SublistPosition,
|
|
function( S, x )
|
|
local i;
|
|
for i in [ 1..Length( S ) ] do if x in S[ i ] then return i; fi; od;
|
|
return fail;
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#F LOOPS_ExtendIsomorphism( f, L, GenL, DisL, M, DisM )
|
|
##
|
|
## Auxiliary.
|
|
## Given a partial map <f> from a quasigroup <L> to a quasigroup <M>,
|
|
## it attempts to extend <f> into an isomorphism betweem <L> and <M>.
|
|
## <GenL>, <DisL> and <DisM> are precalculated and stand for:
|
|
## efficient generators of <L>, invariant subsets of <L>, efficient generators
|
|
## of <M>, respectively.
|
|
|
|
InstallGlobalFunction( LOOPS_ExtendIsomorphism,
|
|
function( f, L, GenL, DisL, M, DisM )
|
|
local x, possible_images, y, g;
|
|
f := LOOPS_ExtendHomomorphismByClosingSource( f, L, M );
|
|
if f = fail or Length( f[ 2 ] ) > Length( f[ 3 ] ) then return fail; fi;
|
|
if Length( f[ 2 ] ) = Length( L ) then return f; fi; #isomorphism found
|
|
|
|
x := GenL[ 1 ];
|
|
GenL := GenL{[2..Length(GenL)]};
|
|
possible_images := Filtered( DisM[ LOOPS_SublistPosition( DisL, x ) ], y -> not y in f[ 3 ] );
|
|
for y in possible_images do
|
|
g := StructuralCopy( f );
|
|
g[ 1 ][ x ] := y; AddSet( g[ 2 ], x ); AddSet( g[ 3 ], y );
|
|
g := LOOPS_ExtendIsomorphism( g, L, GenL, DisL, M, DisM );
|
|
if not g = fail then return g; fi; #isomorphism found
|
|
od;
|
|
return fail;
|
|
end);
|
|
|
|
#############################################################################
|
|
## ISOMORPHISMS OF LOOPS
|
|
## -------------------------------------------------------------------------
|
|
|
|
#############################################################################
|
|
##
|
|
#O IsomorphismQuasigroupsNC( L, GenL, DisL, M, DisM )
|
|
##
|
|
## Auxiliary. Given a quasigroup <L>, its efficient generators <GenL>, the
|
|
## disciminator <DisL> of <L>, and another loop <M> with discriminator
|
|
## <DisM>, it returns an isomorophism from <L> onto <M>, or it fails.
|
|
|
|
InstallGlobalFunction( IsomorphismQuasigroupsNC,
|
|
function( L, GenL, DisL, M, DisM )
|
|
local map, iso;
|
|
if not AreEqualDiscriminators( DisL, DisM ) then return fail; fi;
|
|
|
|
#mapping
|
|
map := 0 * [ 1.. Size( L ) ];
|
|
|
|
if IsLoop( L ) and IsLoop( M ) then
|
|
map[ 1 ] := 1; # identity element is certainly preserved
|
|
iso := LOOPS_ExtendIsomorphism( [ map, [ 1 ], [ 1 ] ], CayleyTable( L ), GenL, DisL[2], CayleyTable( M ), DisM[2] );
|
|
else
|
|
iso := LOOPS_ExtendIsomorphism( [ map, [ ], [ ] ], CayleyTable( L ), GenL, DisL[2], CayleyTable( M ), DisM[2] );
|
|
fi;
|
|
if not iso = fail then return SortingPerm( iso[ 1 ] ); fi;
|
|
return fail;
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#O IsomorphismQuasigroups( L, M )
|
|
##
|
|
## If the quasigroups <L>, <M> are isomorophic, it returns an isomorphism
|
|
## from <L> onto <M>. Fails otherwise.
|
|
|
|
InstallMethod( IsomorphismQuasigroups, "for two quasigroups",
|
|
[ IsQuasigroup, IsQuasigroup ],
|
|
function( L, M )
|
|
local GenL1, GenL2, GenL, DisL, DisM, permL, permM, p, iso;
|
|
|
|
# making sure the quasigroups have canonical Cayley tables
|
|
if not L = Parent( L ) then L := CanonicalCopy( L ); fi;
|
|
if not M = Parent( M ) then M := CanonicalCopy( M ); fi;
|
|
|
|
# turning non-declared loops into loops
|
|
permL := ();
|
|
if (not IsLoop( L )) and (not MultiplicativeNeutralElement( L )=fail) then
|
|
p := Position( Elements( L ), MultiplicativeNeutralElement( L ) );
|
|
if p<>1 then
|
|
permL := (1,p);
|
|
fi;
|
|
L := IntoLoop( L );
|
|
fi;
|
|
permM := ();
|
|
if (not IsLoop( M )) and (not MultiplicativeNeutralElement( M )=fail) then
|
|
p := Position( Elements( M ), MultiplicativeNeutralElement( M ) );
|
|
if p<>1 then
|
|
permM := (1,p);
|
|
fi;
|
|
M := IntoLoop( M );
|
|
fi;
|
|
|
|
DisL := Discriminator( L );
|
|
GenL := LOOPS_EfficientGenerators( L, DisL );
|
|
DisM := Discriminator( M );
|
|
iso := IsomorphismQuasigroupsNC( L, GenL, DisL, M, DisM );
|
|
if not iso = fail then
|
|
iso := permL*iso*permM; # accounting for possible internal conversions to loops
|
|
fi;
|
|
return iso;
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#O IsomorphismLoops( L, M )
|
|
##
|
|
## If the loops <L>, <M> are isomorophic, it returns an isomorphism
|
|
## from <L> onto <M>. Fails otherwise.
|
|
|
|
InstallMethod( IsomorphismLoops, "for loops",
|
|
[ IsLoop, IsLoop ],
|
|
function( L, M )
|
|
return IsomorphismQuasigroups( L, M );
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#O QuasigroupsUpToIsomorphism( ls )
|
|
##
|
|
## Given a list <ls> of quasigroups, returns a sublist of <ls> consisting
|
|
## of represenatives of isomorphism classes of <ls>.
|
|
|
|
InstallMethod( QuasigroupsUpToIsomorphism, "for a list of quasigroups",
|
|
[ IsList ],
|
|
function( ls )
|
|
local i, quasigroups, L, D, G, with_same_D, is_new_quasigroup, K;
|
|
|
|
# making sure only quasigroups are on the list
|
|
if not IsEmpty( Filtered( ls, x -> not IsQuasigroup( x ) ) ) then
|
|
Error("LOOPS: <1> must be a list of quasigroups");
|
|
fi;
|
|
# special case: one quasigroup
|
|
if Length( ls ) = 1 then
|
|
return ls;
|
|
fi;
|
|
# making everything canonical
|
|
ls := ShallowCopy( ls ); # otherwise a side efect occurs in ls
|
|
for i in [1..Length(ls)] do
|
|
if not Parent(ls[i]) = ls[i] then
|
|
ls[i] := CanonicalCopy( ls[i] );
|
|
fi;
|
|
od;
|
|
|
|
quasigroups := [];
|
|
for L in ls do
|
|
D := Discriminator( L );
|
|
G := LOOPS_EfficientGenerators( L, D );
|
|
# will be testing only quasigroups with the same discriminator
|
|
with_same_D := Filtered( quasigroups, K -> AreEqualDiscriminators( K[2], D ) );
|
|
is_new_quasigroup := true;
|
|
for K in with_same_D do
|
|
if not IsomorphismQuasigroupsNC( L, G, D, K[1], K[2] ) = fail then
|
|
is_new_quasigroup := false;
|
|
break;
|
|
fi;
|
|
od;
|
|
if is_new_quasigroup then Add( quasigroups, [ L, D ] ); fi;
|
|
od;
|
|
# returning only quasigroups, not their discriminators
|
|
return List( quasigroups, L -> L[1] );
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#O LoopsUpToIsomorphism( ls )
|
|
##
|
|
## Given a list <ls> of loops, returns a sublist of <ls> consisting
|
|
## of represenatives of isomorphism classes of <ls>.
|
|
|
|
InstallMethod( LoopsUpToIsomorphism, "for a list of loops",
|
|
[ IsList ],
|
|
function( ls )
|
|
# making sure only quasigroups are on the list
|
|
if not IsEmpty( Filtered( ls, x -> not IsQuasigroup( x ) ) ) then
|
|
Error("LOOPS: <1> must be a list of quasigroups");
|
|
fi;
|
|
return QuasigroupsUpToIsomorphism( ls );
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#O IsomorphicCopyByPerm( Q, p )
|
|
##
|
|
## If <Q> is a quasigroup of order n and <p> a permutation of [1..n], returns
|
|
## the quasigroup (Q,*) such that p(xy) = p(x)*p(y).
|
|
## If <Q> is a loop, p is first composed with (1,1^p) to make sure
|
|
## that the neutral element of (Q,*) remains 1.
|
|
|
|
InstallMethod( IsomorphicCopyByPerm, "for a quasigroup and permutation",
|
|
[ IsQuasigroup, IsPerm ],
|
|
function( Q, p )
|
|
local ctQ, ct, inv_p;
|
|
ctQ := CanonicalCayleyTable( CayleyTable( Q ) );
|
|
# if Q is a loop and 1^p > 1, must normalize
|
|
if (IsLoop( Q ) and (not 1^p = 1)) then
|
|
p := p * (1, 1^p );
|
|
fi;
|
|
inv_p := Inverse( p );
|
|
ct := List([1..Size(Q)], i-> List([1..Size(Q)], j ->
|
|
( ctQ[ i^inv_p ][ j^inv_p ] )^p
|
|
) );
|
|
if IsLoop( Q ) then return LoopByCayleyTable( ct ); fi;
|
|
return QuasigroupByCayleyTable( ct );
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#O IsomorphicCopyByNormalSubloop( L, S )
|
|
##
|
|
## Given a loop <L> and its normal subloop <S>, it returns an isomorphic
|
|
## copy of <L> with elements reordered according to right cosests of S
|
|
|
|
InstallMethod( IsomorphicCopyByNormalSubloop, "for two loops",
|
|
[ IsLoop, IsLoop ],
|
|
function( L, S )
|
|
local p;
|
|
if not IsNormal( L, S ) then
|
|
Error( "LOOPS: <2> must be a normal subloop of <1>");
|
|
fi;
|
|
# (PROG) SortingPerm is used rather than PermList since L is not necessarily canonical
|
|
p := Inverse( SortingPerm( PosInParent( Concatenation( RightCosets( L, S ) ) ) ) );
|
|
return IsomorphicCopyByPerm( L, p );
|
|
end);
|
|
|
|
|
|
#############################################################################
|
|
## AUTOMORPHISMS AND AUTOMORPHISM GROUPS
|
|
## -------------------------------------------------------------------------
|
|
|
|
#############################################################################
|
|
##
|
|
#F LOOPS_AutomorphismsFixingSet( S, Q, GenQ, DisQ )
|
|
##
|
|
## Auxiliary function.
|
|
## Given a quasigroup <Q>, its subset <S>, the efficient generators
|
|
## <GenQ> of <Q> and and invariant subsets <DisQ> of <Q>, it returns all
|
|
## automorphisms of <Q> fixing the set <S> pointwise.
|
|
|
|
InstallGlobalFunction( LOOPS_AutomorphismsFixingSet,
|
|
function( S, Q, GenQ, DisQ )
|
|
local n, x, A, possible_images, y, i, map, g;
|
|
|
|
# this is faster than extending a map
|
|
n := Size( Q );
|
|
S := Subquasigroup( Q, S ); # can be empty if Q is not a loop
|
|
if Size( S ) = n then return []; fi; # identity, no need to return
|
|
S := List( S, x -> Position( Elements( Q ), x ) );
|
|
|
|
#pruning blocks
|
|
DisQ := List( DisQ, B -> Filtered( B, x -> not x in S ) );
|
|
|
|
# first unmapped generator
|
|
x := GenQ[ 1 ];
|
|
GenQ := GenQ{[2..Length(GenQ)]};
|
|
|
|
A := [];
|
|
|
|
possible_images := Filtered( DisQ[ LOOPS_SublistPosition( DisQ, x ) ], y -> y <> x );
|
|
for y in possible_images do
|
|
# constructing map
|
|
map := 0*[1..n];
|
|
for i in [1..n] do if i in S then map[ i ] := i; fi; od;
|
|
map[ x ] := y;
|
|
g := [ map, Union( S, [ x ] ), Union( S, [ y ] ) ];
|
|
# extending map
|
|
g := LOOPS_ExtendIsomorphism( g, CayleyTable( Q ), GenQ, DisQ, CayleyTable( Q ), DisQ );
|
|
if not g = fail then AddSet( A, g[ 1 ] ); fi;
|
|
od;
|
|
|
|
S := Union( S, [ x ] );
|
|
return Union( A, LOOPS_AutomorphismsFixingSet( S, Q, GenQ, DisQ ) );
|
|
end);
|
|
|
|
#############################################################################
|
|
##
|
|
#F AutomorphismGroup( Q )
|
|
##
|
|
## Returns the automorphism group of a quasigroup <Q>,
|
|
## as a permutation group on [1..Size(Q)].
|
|
|
|
InstallOtherMethod( AutomorphismGroup, "for quasigroup",
|
|
[ IsQuasigroup ],
|
|
function( Q )
|
|
local DisQ, GenQ, A;
|
|
# making sure Q has canonical Cayley table
|
|
if not Q = Parent( Q ) then Q := CanonicalCopy( Q ); fi;
|
|
DisQ := Discriminator( Q );
|
|
GenQ := LOOPS_EfficientGenerators( Q, DisQ );
|
|
|
|
if IsLoop( Q ) then
|
|
A := LOOPS_AutomorphismsFixingSet( [ 1 ], Q, GenQ, DisQ[2] );
|
|
else
|
|
A := LOOPS_AutomorphismsFixingSet( [ ], Q, GenQ, DisQ[2] );
|
|
fi;
|
|
|
|
if IsEmpty( A ) then return Group( () ); fi; # no notrivial automorphism
|
|
return Group( List( A, p -> SortingPerm( p ) ) );
|
|
end);
|
|
|
|
#############################################################################
|
|
## ISOTOPISM OF LOOPS
|
|
## ------------------------------------------------------------------------
|
|
|
|
#############################################################################
|
|
##
|
|
#O IsotopismLoops( L1, L2 )
|
|
##
|
|
## If L1, L2 are isotopic loops, returns true, else fail.
|
|
|
|
# (MATH) First we calculate all principal loop isotopes of L1 of the form
|
|
# PrincipalLoopIsotope(L1, f, g), where f, g, are elements of L1.
|
|
# Then we filter these up to isomorphism. If L2 is isotopic to L1, then
|
|
# L2 is isomorphic to one of these principal isotopes.
|
|
|
|
InstallMethod( IsotopismLoops, "for two loops",
|
|
[ IsLoop, IsLoop ],
|
|
function( L1, L2 )
|
|
local istps, fg, f, g, L, phi, pos, alpha, beta, gamma, p;
|
|
|
|
# make all loops canonical to be able to calculate isotopisms
|
|
if not L1 = Parent( L1 ) then L1 := LoopByCayleyTable( CayleyTable( L1 ) ); fi;
|
|
if not L2 = Parent( L2 ) then L2 := LoopByCayleyTable( CayleyTable( L2 ) ); fi;
|
|
|
|
# first testing for isotopic invariants
|
|
if not Size(L1)=Size(L2) then return fail; fi;
|
|
if IsomorphismLoops( Center(L1), Center(L2) ) = fail then return fail; fi;
|
|
if IsomorphismLoops( LeftNucleus(L1), LeftNucleus(L2) ) = fail then return fail; fi;
|
|
if IsomorphismLoops( RightNucleus(L1), RightNucleus(L2) ) = fail then return fail; fi;
|
|
if IsomorphismLoops( MiddleNucleus(L1), MiddleNucleus(L2) ) = fail then return fail; fi;
|
|
# we could test for isomorphism among multiplication groups and inner mapping group, too
|
|
if not Size(MultiplicationGroup(L1)) = Size(MultiplicationGroup(L2)) then return fail; fi;
|
|
if not Size(InnerMappingGroup(L1)) = Size(InnerMappingGroup(L2)) then return fail; fi;
|
|
|
|
# now trying to construct an isotopism
|
|
istps := [];
|
|
fg := [];
|
|
for f in L1 do for g in L1 do
|
|
Add(istps, PrincipalLoopIsotope( L1, f, g ));
|
|
Add(fg, [ f, g ] );
|
|
od; od;
|
|
for L in LoopsUpToIsomorphism( istps ) do
|
|
phi := IsomorphismLoops( L, L2 );
|
|
if not phi = fail then
|
|
# must reconstruct the isotopism (alpha, beta, gamma)
|
|
# first figure out what f and g were
|
|
pos := Position( istps, L );
|
|
f := fg[ pos ][ 1 ];
|
|
g := fg[ pos ][ 2 ];
|
|
alpha := RightTranslation( L1, g );
|
|
beta := LeftTranslation( L1, f );
|
|
# we also applied an isomorphism (1,f*g) inside PrincipalLoopIsotope
|
|
p := Position( L1, f*g );
|
|
gamma := ();
|
|
if p > 1 then
|
|
alpha := alpha * (1,p);
|
|
beta := beta * (1,p);
|
|
gamma := gamma * (1,p);
|
|
fi;
|
|
# finally, we apply the isomorphism phi
|
|
alpha := alpha * phi;
|
|
beta := beta * phi;
|
|
gamma := gamma * phi;
|
|
return [ alpha, beta, gamma ];
|
|
fi;
|
|
od;
|
|
return fail;
|
|
end);
|
|
|
|
|
|
#############################################################################
|
|
##
|
|
#O LoopsUpToIsotopism( ls )
|
|
##
|
|
## Given a list <ls> of loops, returns a sublist of <ls> consisting
|
|
## of represenatives of isotopism classes of <ls>. VERY SLOW!
|
|
|
|
InstallMethod( LoopsUpToIsotopism, "for a list of loops",
|
|
[ IsList ],
|
|
function( ls )
|
|
local loops, L, is_new_loop, K, M, istps, f, g;
|
|
# making sure only loops are on the list
|
|
if not IsEmpty( Filtered( ls, x -> not IsLoop( x ) ) ) then
|
|
Error("LOOPS: <1> must be a list of loops");
|
|
fi;
|
|
loops := [];
|
|
for L in ls do
|
|
is_new_loop := true;
|
|
# find all principal isotopes of L up to isomorphism
|
|
istps := [];
|
|
for f in L do for g in L do
|
|
Add(istps, PrincipalLoopIsotope( L, f, g ) );
|
|
od; od;
|
|
istps := LoopsUpToIsomorphism(istps);
|
|
# check if any is isomorphic to a found loop
|
|
for K in loops do for M in istps do
|
|
if not IsomorphismLoops( K, M ) = fail then
|
|
is_new_loop := false; break;
|
|
fi;
|
|
od; od;
|
|
if is_new_loop then Add( loops, L ); fi;
|
|
od;
|
|
return loops;
|
|
end);
|