2021-05-09 18:54:29 +02:00
function KnuthBendix . Alphabet ( S :: AbstractVector { <: GSymbol } )
S = unique! ( [ S ; inv . ( S ) ] )
inversions = [ findfirst ( == ( inv ( s ) ) , S ) for s in S ]
return Alphabet ( S , inversions )
end
2022-10-14 01:03:19 +02:00
struct AutomorphismGroup { G <: Group , T , RW , S } <: AbstractFPGroup
2021-05-09 18:54:29 +02:00
group :: G
gens :: Vector { T }
2022-10-14 01:03:19 +02:00
rw :: RW
2021-05-09 18:54:29 +02:00
domain :: S
end
object ( G :: AutomorphismGroup ) = G . group
2022-10-14 01:03:19 +02:00
rewriting ( G :: AutomorphismGroup ) = G . rw
2021-05-09 18:54:29 +02:00
2021-06-29 16:52:35 +02:00
function equality_data ( f :: AbstractFPGroupElement { <: AutomorphismGroup } )
2021-05-24 01:07:59 +02:00
imf = evaluate ( f )
# return normalform!.(imf)
tmp = one ( first ( imf ) )
for g in imf
normalform! ( tmp , g )
copyto! ( g , tmp )
end
return imf
end
2021-05-09 18:54:29 +02:00
2021-06-29 16:52:35 +02:00
function Base . : ( == ) ( g :: A , h :: A ) where { A <: AbstractFPGroupElement { <: AutomorphismGroup } }
2021-05-09 18:54:29 +02:00
@assert parent ( g ) === parent ( h )
if _isvalidhash ( g ) && _isvalidhash ( h )
hash ( g ) != hash ( h ) && return false
end
2021-05-16 22:30:50 +02:00
length ( word ( g ) ) > 8 && normalform! ( g )
length ( word ( h ) ) > 8 && normalform! ( h )
2021-05-09 18:54:29 +02:00
2021-05-16 22:30:50 +02:00
word ( g ) == word ( h ) && return true
2021-05-09 18:54:29 +02:00
img_computed , imh_computed = false , false
if ! _isvalidhash ( g )
2021-05-16 22:27:54 +02:00
img = equality_data ( g )
2021-05-09 18:54:29 +02:00
_update_savedhash! ( g , img )
img_computed = true
end
if ! _isvalidhash ( h )
2021-05-16 22:27:54 +02:00
imh = equality_data ( h )
2021-05-09 18:54:29 +02:00
_update_savedhash! ( h , imh )
imh_computed = true
end
@assert _isvalidhash ( g )
@assert _isvalidhash ( h )
hash ( g ) != hash ( h ) && return false
# words are different, but hashes agree
2021-05-16 23:16:35 +02:00
if ! img_computed
img = equality_data ( g )
end
if ! imh_computed
imh = equality_data ( h )
2021-05-09 18:54:29 +02:00
end
2021-05-16 22:27:54 +02:00
equal = img == imh
equal || @warn " hash collision in == : " g h
2021-05-09 18:54:29 +02:00
2021-05-16 22:27:54 +02:00
return equal
2021-05-09 18:54:29 +02:00
end
2021-06-29 16:52:35 +02:00
function Base . isone ( g :: AbstractFPGroupElement { <: AutomorphismGroup } )
2021-05-26 12:03:28 +02:00
if length ( word ( g ) ) > 8
normalform! ( g )
end
return evaluate ( g ) == parent ( g ) . domain
end
2021-05-09 18:54:29 +02:00
# eye-candy
2021-12-13 09:54:32 +01:00
Base . show ( io :: IO , :: Type { <: FPGroupElement { <: AutomorphismGroup { T } } } ) where { T } =
print ( io , " Automorphism{ $T , …} " )
2021-05-09 18:54:29 +02:00
2021-05-26 12:07:15 +02:00
Base . show ( io :: IO , A :: AutomorphismGroup ) = print ( io , " automorphism group of " , object ( A ) )
2021-07-05 15:05:37 +02:00
function Base . show ( io :: IO , :: MIME " text/plain " , a :: AbstractFPGroupElement { <: AutomorphismGroup } )
println ( io , " ┌ $ ( a ) : " )
d = domain ( a )
im = evaluate ( a )
for ( x , imx ) in zip ( d , im [ 1 : end - 1 ] )
println ( io , " │ $x ↦ $imx " )
end
println ( io , " └ $ ( last ( d ) ) ↦ $ ( last ( im ) ) " )
end
2021-05-09 18:54:29 +02:00
## Automorphism Evaluation
2021-06-29 16:52:35 +02:00
domain ( f :: AbstractFPGroupElement { <: AutomorphismGroup } ) = deepcopy ( parent ( f ) . domain )
2021-05-09 18:54:29 +02:00
# tuple(gens(object(parent(f)))...)
2021-06-29 16:52:35 +02:00
evaluate ( f :: AbstractFPGroupElement { <: AutomorphismGroup } ) = evaluate! ( domain ( f ) , f )
2021-06-07 20:23:04 +02:00
function evaluate! (
t :: NTuple { N , T } ,
2021-06-29 16:52:35 +02:00
f :: AbstractFPGroupElement { <: AutomorphismGroup { <: Group } } ,
2022-10-14 01:14:38 +02:00
tmp = one ( first ( t ) ) ,
) where { N , T <: FPGroupElement }
2021-06-07 20:23:04 +02:00
A = alphabet ( f )
for idx in word ( f )
2021-08-13 13:48:25 +02:00
t = @inbounds evaluate! ( t , A [ idx ] , tmp ) :: NTuple { N , T }
2021-06-07 20:23:04 +02:00
end
return t
2021-05-09 18:54:29 +02:00
end
2021-06-07 20:23:04 +02:00
2022-10-14 01:14:38 +02:00
evaluate! ( t :: NTuple { N , T } , s :: GSymbol , tmp = nothing ) where { N , T } = throw ( " you need to implement `evaluate!(:: $ ( typeof ( t ) ) , :: $ ( typeof ( s ) ) , ::Alphabet, tmp=one(first(t)))` " )
2021-07-09 16:46:15 +02:00
# forward evaluate by substitution
2022-10-14 01:14:38 +02:00
struct LettersMap { T , A }
indices_map :: Dict { Int , T }
2021-07-09 16:46:15 +02:00
A :: A
end
function LettersMap ( a :: FPGroupElement { <: AutomorphismGroup } )
dom = domain ( a )
@assert all ( isone ∘ length ∘ word , dom )
A = alphabet ( first ( dom ) )
first_letters = first . ( word . ( dom ) )
img = evaluate! ( dom , a )
# (dom[i] → img[i] is a map from domain to images)
# we need a map from alphabet indices → (gens, gens⁻¹) → images
2021-08-13 13:48:25 +02:00
# here we do it for elements of the domain
2021-07-09 16:46:15 +02:00
# (trusting it's a set of generators that define a)
@assert length ( dom ) == length ( img )
indices_map = Dict ( A [ A [ fl ] ] => word ( im ) for ( fl , im ) in zip ( first_letters , img ) )
# inverses of generators are dealt lazily in getindex
return LettersMap ( indices_map , A )
end
function Base . getindex ( lm :: LettersMap , i :: Integer )
# here i is an index of an alphabet
2022-10-13 23:21:42 +02:00
@boundscheck 1 ≤ i ≤ length ( lm . A )
2021-07-09 16:46:15 +02:00
if ! haskey ( lm . indices_map , i )
2022-10-13 23:27:50 +02:00
img = if haskey ( lm . indices_map , inv ( i , lm . A ) )
inv ( lm . indices_map [ inv ( i , lm . A ) ] , lm . A )
2021-07-09 16:46:15 +02:00
else
@warn " LetterMap: neither $i nor its inverse has assigned value "
one ( valtype ( lm . indices_map ) )
end
lm . indices_map [ i ] = img
end
return lm . indices_map [ i ]
end
function ( a :: FPGroupElement { <: AutomorphismGroup } ) ( g :: FPGroupElement )
@assert object ( parent ( a ) ) === parent ( g )
img_w = evaluate ( word ( g ) , LettersMap ( a ) )
return parent ( g ) ( img_w )
end
evaluate ( w :: AbstractWord , lm :: LettersMap ) = evaluate! ( one ( w ) , w , lm )
function evaluate! ( res :: AbstractWord , w :: AbstractWord , lm :: LettersMap )
for i in w
append! ( res , lm [ i ] )
end
return res
end
2021-07-17 20:11:32 +02:00
# compile automorphisms
compiled ( a ) = eval ( generated_evaluate ( a ) )
function generated_evaluate ( a :: FPGroupElement { <: AutomorphismGroup } )
lm = Groups . LettersMap ( a )
d = Groups . domain ( a )
@assert all ( length . ( word . ( d ) ) .== 1 )
A = alphabet ( first ( d ) )
first_ltrs = first . ( word . ( d ) )
args = [ Expr ( :call , : * ) for _ in first_ltrs ]
for ( idx , letter ) in enumerate ( first_ltrs )
for l in lm [ letter ]
k = findfirst ( == ( l ) , first_ltrs )
if k !== nothing
push! ( args [ idx ] . args , : ( d [ $ k ] ) )
continue
end
2022-10-13 23:27:50 +02:00
k = findfirst ( == ( inv ( l , A ) ) , first_ltrs )
2021-07-17 20:11:32 +02:00
if k !== nothing
push! ( args [ idx ] . args , : ( inv ( d [ $ k ] ) ) )
continue
end
throw ( " Letter $l doesn't seem to be mapped anywhere! " )
end
end
2022-10-14 01:14:38 +02:00
locals = Dict { Expr , Symbol } ( )
2021-07-17 20:11:32 +02:00
locals_counter = 0
2022-10-14 01:14:38 +02:00
for ( i , v ) in enumerate ( args )
2021-07-17 20:11:32 +02:00
@assert length ( v . args ) >= 2
if length ( v . args ) > 2
for ( j , a ) in pairs ( v . args )
2022-10-14 01:14:38 +02:00
if a isa Expr && a . head == :call
" $a "
2021-07-17 20:11:32 +02:00
@assert a . args [ 1 ] == :inv
if ! ( a in keys ( locals ) )
locals [ a ] = Symbol ( " var_# $locals_counter " )
locals_counter += 1
end
v . args [ j ] = locals [ a ]
end
end
else
args [ i ] = v . args [ 2 ]
end
end
q = quote
2022-10-14 01:14:38 +02:00
$ ( [ : ( local $ v = $ k ) for ( k , v ) in locals ] ... )
2021-07-17 20:11:32 +02:00
end
# return args, locals
return : ( d -> begin
@boundscheck @assert length ( d ) == $ ( length ( d ) )
$ q
@inbounds tuple ( $ ( args ... ) )
end )
end