Fix isomorphisms from fp monoid to fp semigroup

lib/fpmon.gd

@@ -213,7 +213,8 @@ DeclareAttribute("RelationsOfFpMonoid",IsFpMonoid);
 ##  </Description>
 ##  </ManSection>
 ##
-DeclareAttribute("IsomorphismFpMonoid",IsMonoid);
+
+DeclareAttribute("IsomorphismFpMonoid",IsSemigroup);
 
 ############################################################################
 ##

lib/fpmon.gi

@@ -18,38 +18,38 @@
 #M  ElementOfFpMonoid( <fam>, <elm> )
 ##
 InstallMethod( ElementOfFpMonoid,
-	"for a family of f.p. monoid elements, and an assoc. word",
-	true,
-	[ IsElementOfFpMonoidFamily, IsAssocWordWithOne ],
-	0,
-	function( fam, elm )
-		return Objectify( fam!.defaultType, [ Immutable( elm ) ] );
-	end );
+        "for a family of f.p. monoid elements, and an assoc. word",
+        true,
+        [ IsElementOfFpMonoidFamily, IsAssocWordWithOne ],
+        0,
+        function( fam, elm )
+                return Objectify( fam!.defaultType, [ Immutable( elm ) ] );
+        end );
 
 #############################################################################
 ##
 #M  UnderlyingElement( <elm> )  . . . . . . for element of fp monoid 
 ##
 InstallMethod( UnderlyingElement,
-	"for an element of an fp monoid (default repres.)",
-	true,
-	[ IsElementOfFpMonoid and IsPackedElementDefaultRep ],
-	0,
-	obj -> obj![1] );
+        "for an element of an fp monoid (default repres.)",
+        true,
+        [ IsElementOfFpMonoid and IsPackedElementDefaultRep ],
+        0,
+        obj -> obj![1] );
 
 #############################################################################
 ##
 #M  \*( <x1>, <x2> )
 ##
 InstallMethod( \*,
-	"for two elements of a fp monoid",
-	IsIdenticalObj,
-	[ IsElementOfFpMonoid, IsElementOfFpMonoid],
-	0,
-	function( x1, x2 )
-		return ElementOfFpMonoid(FamilyObj(x1),
-						UnderlyingElement(x1)*UnderlyingElement(x2));
-	end );
+        "for two elements of a fp monoid",
+        IsIdenticalObj,
+        [ IsElementOfFpMonoid, IsElementOfFpMonoid],
+        0,
+        function( x1, x2 )
+                return ElementOfFpMonoid(FamilyObj(x1),
+                                                UnderlyingElement(x1)*UnderlyingElement(x2));
+        end );
 
 #############################################################################
 ##
@@ -82,11 +82,11 @@ InstallMethod( \=,
     [ IsElementOfFpMonoid, IsElementOfFpMonoid],
     0,
     function( x1, x2 )
-			local m,rws;
+                        local m,rws;
 
-			m := CollectionsFamily(FamilyObj(x1))!.wholeMonoid;
+                        m := CollectionsFamily(FamilyObj(x1))!.wholeMonoid;
       rws:= ReducedConfluentRewritingSystem(m);
-	
+        
       return ReducedForm(rws, UnderlyingElement(x1)) =
           ReducedForm(rws, UnderlyingElement(x2));
 
@@ -140,16 +140,16 @@ end );
 #M  FpMonoidOfElementOfFpMonoid( <elm> )
 ##
 InstallMethod( FpMonoidOfElementOfFpMonoid,
-	"for an fp monoid element", true,
-	[IsElementOfFpMonoid], 0,
-	elm -> CollectionsFamily(FamilyObj(elm))!.wholeMonoid);
+        "for an fp monoid element", true,
+        [IsElementOfFpMonoid], 0,
+        elm -> CollectionsFamily(FamilyObj(elm))!.wholeMonoid);
 
 #############################################################################
 ##
 #M  FpGrpMonSmgOfFpGrpMonSmgElement( <elm> )
 ##
-##	for an fp monoid element <elm> returns the fp monoid to which
-##	<elm> belongs to 
+##      for an fp monoid element <elm> returns the fp monoid to which
+##      <elm> belongs to 
 ##
 InstallMethod(FpGrpMonSmgOfFpGrpMonSmgElement,
   "for an element of an fp monoid", true,
@@ -210,7 +210,7 @@ function( F, rels )
     if Length(gens) > Length(rels) then
       SetIsFinite(s, false);
     fi;
-	
+        
     return s;
 end);
 
@@ -392,121 +392,74 @@ function(f, s)
   return MagmaHomomorphismByFunctionNC(f, s, e->UnderlyingElement(e)^psi);
 end);
 
-######################################################################
-##
-#M	IsomorphismFpSemigroup(<S>)
-##
-InstallMethod(IsomorphismFpSemigroup,
-	"for an fp monoid", true,
-	[  IsFpMonoid ],0,
-function(s)
-
-local fm,						# free monoid underlying s
-			fs,						# free semigroup
-                        gensfreemon,    # generators of fm
-			freesmggens,	# generators of fs
-			idgen,				# the generator of fs corresponding to the identity
-			rels,					# relations of the fp monoid s
-			rel,					# a relation from rels
-			smgrels,			# the fp monoid relations rewritten for semigroups
-			smgrel,				# a relation from smgrels
-			i,						# loop variable
-			smg,					# the fp semigroup
-			gens,					# generators of smg
-			id,						# identity of fm
-			isomfun,			# the isomorphism
-			nat,					# homomorphism from fm to s
-			invfun,				# the inverse of isomfun
-			monword2smgword,	
-			smgword2monword;
-
-  ################################################
-  # monword2smgword
-  # Change a word in the free monoid into a word
-  # in the free semigroup. 
-  ################################################
-  monword2smgword := function(id, w)
-    local wlist,    # external rep of the word
-					i;				# loop variable
+InstallMethod(IsomorphismFpSemigroup, "for an fp monoid", [IsFpMonoid], 
+function(M)
+  local FMtoFS, FStoFM, FM, FS, id, rels, next, S, map, inv, x, rel;
+
+  # Convert a word in the free monoid into a word in the free semigroup
+  FMtoFS := function(id, w)
+    local wlist, i;
 
     wlist := ShallowCopy(ExtRepOfObj(w));
 
     if Length(wlist) = 0 then # it is the identity
       return id;
     fi;
 
-		# have to increment the generators by one to shift
-		# past the identity generator
-		for i in [1..1/2*(Length(wlist))] do
-			wlist[2*i-1] := wlist[2*i-1]+1;
-		od;
-	
+    # have to increment the generators by one to shift past the identity
+    # generator
+    for i in [1 .. 1 / 2 * (Length(wlist))] do
+      wlist[2 * i - 1] := wlist[2 * i - 1] + 1;
+    od;
+
     return ObjByExtRep(FamilyObj(id), wlist);
   end;
 
-  ################################################
-  # smgword2monword
-  # Change a word in the free semigroup into a word
-  # in the free monoid. 
-  ################################################
-	smgword2monword := function(id,w)
-		local wlist;		# external rep of the word
-
-		wlist := ExtRepOfObj(w); 
-
-		if Length(wlist)=0 or (wlist=[1,1]) then # it is the identity
-			return id;
-		fi;
-
-		# have to decrease each entry by one because
-		# of the identity generator
-
-
-		return ObjByExtRep(FamilyObj(id),wlist);
-	end;
-
-
-	#################
-	# function proper
-
-	# first we create the fp semigroup
-
-	# get the free monoid underlying the given fp monoid
-	fm := FreeMonoidOfFpMonoid(s);
-	# build the free semigroup
-        gensfreemon := List(GeneratorsOfSemigroup( fm ),String);
-	fs := FreeSemigroup(gensfreemon);
-
-	freesmggens := GeneratorsOfSemigroup(fs);
-	idgen := freesmggens[1];
-
-	# now the relations that make idgen an identity
-	smgrels := [[idgen*idgen,idgen]];
-	for i in [2..Length(freesmggens)] do
-		Add(smgrels, [idgen*freesmggens[i],freesmggens[i]]);
-		Add(smgrels, [freesmggens[i]*idgen,freesmggens[i]]);
-	od;
-
-	# now we have to rewrite each of the fp monoid relations
-	# in terms of words in fs 
-	rels := RelationsOfFpMonoid(s);
-	for rel in rels do
-		smgrel := [monword2smgword(idgen,rel[1]),monword2smgword(idgen,rel[2])];
-		Add(smgrels,smgrel);	
-	od;
-
-	# finally create the fp semigroup
-	smg := FactorFreeSemigroupByRelations(fs,smgrels);
-	gens := GeneratorsOfSemigroup(smg);
-
-	isomfun := x -> ElementOfFpSemigroup( FamilyObj(gens[1] ),
-                  monword2smgword( idgen, UnderlyingElement(x)));
-
-	id := One(fm);
-	nat := NaturalHomomorphismByGenerators(fm,s);
-	invfun := x-> Image( nat,smgword2monword(id,UnderlyingElement(x))); 
-
-	return MagmaIsomorphismByFunctionsNC(s,smg,isomfun,invfun);
+  # Convert a word in the free semigroup into a word in the free monoid. 
+  FStoFM := function(id, w)
+    local wlist, i;
 
-end);
+    wlist := ExtRepOfObj(w); 
+
+    if Length(wlist) = 0 or (wlist = [1, 1]) then # it is the identity
+      return id;
+    fi;
+
+    # have to decrease each entry by one because of the identity generator
+    for i in [1 .. 1 / 2 * (Length(wlist))] do
+      wlist[2 * i - 1] := wlist[2 * i - 1] - 1;
+    od;
+    return ObjByExtRep(FamilyObj(id), wlist);
+  end;
+
+  FM := FreeMonoidOfFpMonoid(M);
+  FS := FreeSemigroup(List(GeneratorsOfSemigroup(FM), String));
+
+  id := FS.(Position(GeneratorsOfSemigroup(FM), One(FM)));
+
+  # Add the relations that make id an identity
+  rels := [[id * id, id]];
+  for x in GeneratorsOfSemigroup(FS) do
+    if x <> id then 
+      Add(rels, [id * x, x]);
+      Add(rels, [x * id, x]);
+    fi;
+  od;
+
+  # Rewrite the fp monoid relations as relations over FS
+  for rel in RelationsOfFpMonoid(M) do
+    next := [FMtoFS(id, rel[1]), FMtoFS(id, rel[2])];
+    Add(rels, next);    
+  od;
 
+  # finally create the fp semigroup
+  S := FS / rels; 
+
+  map := x -> ElementOfFpSemigroup(FamilyObj(S.1),
+                                   FMtoFS(id, UnderlyingElement(x)));
+
+  inv := x -> Image(NaturalHomomorphismByGenerators(FM, M), 
+                    FStoFM(One(FM), UnderlyingElement(x))); 
+
+ return MagmaIsomorphismByFunctionsNC(M, S, map, inv);
+end);

tst/testinstall/fpmon.tst

@@ -0,0 +1,24 @@
+#############################################################################
+##
+#W  fpmon.tst
+#Y  James D. Mitchell
+##
+#############################################################################
+##
+
+gap> START_TEST("fpmon.tst");
+
+# Test that the inverse of an isomorphism from an fp monoid to an fp semigroup
+# is really the inverse.
+gap> F := FreeMonoid(2);; 
+gap> rels := [ [ F.1^2, F.1 ], [ F.2^2, F.2 ], [ F.1*F.2*F.1, F.1*F.2 ], 
+> [ F.2*F.1*F.2, F.1*F.2 ] ];;
+gap> S := F / rels;
+<fp monoid on the generators [ m1, m2 ]>
+gap> map := IsomorphismFpSemigroup(S);;
+gap> inv := InverseGeneralMapping(map);;
+gap> ForAll(S, x -> (x ^ map) ^ inv = x);
+true
+
+#
+gap> STOP_TEST( "fpmon.tst", 10000);