GAP: Function to create Origami monoid of given finitely presented monoid with all idempotent generators

Mapper:=function(word,arg)

	local i, u, v, w, prod, monoid;
	w:=ExtRepOfObj(word);
	prod:=[];
	if IsMonoid(arg) then
		monoid:=arg;
		for i in [1..(Length(w)/2)] do
			u:=monoid.(w[2*i-1])^(w[2*i]);
			Add(prod, u);
		od;
	elif IsSemigroup(arg) then
		monoid:=arg;
		for i in [1..(Length(w)/2)] do
			u:=monoid.(w[2*i-1])^(w[2*i]);
			Add(prod, u);
		od;
	else
		for i in [1..(Length(w)/2)] do
			u:=arg[(w[2*i-1])]^(w[2*i]);
			Add(prod, u);
		od;
	fi;
	v:=Product(prod);
	return v;
end;
		
	


OrigamiMonoidIdemp:=function(monoid)

	local gens, mgens, rels, newrels, mrels, agens, bgens, arels, brels, abgens, bagens, doublegens, doublerels, w, free, left, right, abrels, barels, M, rws, freeaddrules, creatingrules, i, j, n, generatorMap, fgens, pos, gens0, mapped, commrels;
		

	# Step 0: Check if M is a finitely presented monoid
	if not IsFpMonoid(monoid) then
		Print("Not a monoid. \n");
		return fail;
	fi;

	gens:=[];
	for i in [1..Size(GeneratorsOfMonoid(monoid))] do
		Add(gens, monoid.(i));
	od;
	n:=Size(gens);
	rels:=RelationsOfFpMonoid(monoid);
	newrels:=[];
	for i in rels do
		if not i[1]=i[2] then
			Add(newrels,i);
		fi;
	od;
	rels:=newrels;
		

	# Step 1: Define new generators (doubling a's and creating b's) and create free monoid
	agens:=[];
	bgens:=[];
	# Create new names like a1,a2,... and b1,b2,... for generators
	for i in [1..Length(gens)] do
		Add(agens, Concatenation("a", String(i)));
		Add(bgens, Concatenation("b", String(i)));  
	od;
	mgens:=Concatenation(agens,bgens);

	# create free monoid and reassign mgens to be generators of free monoid
	free:=FreeMonoid(mgens);
	generatorMap := rec();
	fgens:=GeneratorsOfMonoid(free);
	
	agens := [];
	for i in [1..n] do
		Add(agens,free.(i));
	od;

	bgens := [];
	for i in [n+1..Size(GeneratorsOfMonoid(free))] do
		Add(bgens,free.(i));
	od;


	# Step 2a: Start creating arels;
	arels:=[];
	for i in rels do
		left:=Mapper(i[1],agens);
		right:=Mapper(i[2],agens);
		Add(arels,[left,right]);
	od;

	# Step 2b: Start Creating brels
	brels:=[];
	for i in rels do
		left:=Mapper(i[1],bgens);
		right:=Mapper(i[2],bgens);
		Add(brels,[left,right]);
	od;
	mrels:=[];
	UniteSet(mrels,arels);
	UniteSet(mrels,brels);

	# Step 3: Create ab, ba rels
	doublerels:=[];
	doublegens:=[];
	abgens:=[];
	bagens:=[];
	for i in agens do
		pos:=Position(agens,i);
		w:=i*bgens[pos];
		Add(abgens,w);
	od;
	for i in bgens do
		pos:=Position(bgens,i);
		w:=i*agens[pos];
		Add(bagens,w);
	od;
	UniteSet(doublegens, abgens);
	UniteSet(doublegens,bagens);
	for i in mrels do
		left:=Mapper(i[1],doublegens);
		right:=Mapper(i[2],doublegens);
		Add(doublerels,[left,right]);
	od;

	# Step 4: Create commutation relations
	commrels:=[];
	for i in agens do
		for j in bgens do
			if not Position(agens, i) = Position(bgens, j) then 
				left:=j*i;
				right:=i*j;
				Add(commrels, [left,right]);
			fi;
		od;
	od;

	# Step 5: Unite rules
	rels:=[];
	arels:=Set(arels);
	brels:=Set(brels);
	doublerels:=Set(doublerels);
	commrels:=Set(commrels);
	UniteSet(rels,arels);
	UniteSet(rels,brels);
	UniteSet(rels,doublerels);
	UniteSet(rels,commrels);
	
	# Step 6: Create final monoid and return
	M:=free/rels;
	
	return M;
end;