isosig.gi

###############################################################################
##
##  simpcomp / isosig.gi
##
##  Functions to compute the isomorphism signature of a complex
##
##  $Id$
##
################################################################################

################################################################################
##<#GAPDoc Label="SCExportIsoSig">
## <ManSection>
## <Meth Name="SCExportIsoSig" Arg="c"/>
## <Returns>string upon success, <K>fail</K> otherwise.</Returns>
## <Description>
## Computes the isomorphism signature of a closed, strongly connected weak 
## pseudomanifold. The isomorphism signature is stored as an attribute of the
## complex.
## <Example>
## gap> c:=SCSeriesBdHandleBody(3,9);;
## gap> s:=SCExportIsoSig(c);
## </Example>
## </Description>
## </ManSection>
##<#/GAPDoc>
################################################################################
InstallMethod(SCExportIsoSig,
"for SCSimplicialComplex",
[SCIsSimplicialComplex],
function(c)
	local minl, i, j, k, n, nn, d, neighbors, facets, perm, l, queue, ctr, 
		ctr2, ctr3, labeling, current, face, s, isosig, done, next, 
		addNextValue;

	if SCIsEmpty(c) then
		return ".";
	fi;

	if SCHasBoundary(c) or not SCIsStronglyConnected(c) or not SCIsPseudoManifold(c) then
		Info(InfoSimpcomp,1,"SCExportIsoSig: argument must be a strongly connected closed pseudomanifold.");
		return fail;
	fi;

	addNextValue:=function(val)
		local lut,str,ctr,prefix;
		lut := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ)!@#$%^&*(+.";
		str:="";
		if val = 0 then
			Add(str,lut[64]);
			return str;
		elif val > 0 and val < 64 then
			Add(str,lut[val]);
			return str;
		else
			ctr:=0;
			while val > 0 do
				ctr:=ctr+1;
				Add(str,lut[((val-1) mod 64)+1]);
				val := Int(val/64);
			od;
			prefix := ShallowCopy(String(ctr));
			str := Reversed(str);
			Append(prefix,str);
			return prefix;
		fi;
	end;

	facets := SCFacetsEx(c);
	if facets = fail then
		return fail;
	fi;
	n := Size(facets);
	s := Size(facets[1]);
	# build list of neighbors
	neighbors := [];
	for i in [1..n] do
		neighbors[i]:=[];
		for j in [1..n] do
			if i = j then continue; fi;
			if Size(Intersection(facets[i],facets[j])) = s-1 then
				Add(neighbors[i],j);
			fi;
		od;
	od;
	minl := [];
	for i in [1..n] do
		for perm in PermutationsList(facets[i]) do
			# for each "canonical labeling seed" calculate signature
			l := [];
			labeling := perm;
			queue := [i];
			done := [1];
			ctr := 0;
			ctr2 := 0;
			ctr3 := 0;
			next := false;
			while ctr2 < n-1 do
				ctr := ctr+1;
				current := queue[ctr];
				for j in labeling do
					if not j in facets[current] then continue; fi;
					face := ShallowCopy(facets[current]);
					Remove(face,Position(face,j));
					Sort(face);
					for nn in neighbors[current] do
						if nn in queue then continue; fi;
						if IsSubset(facets[nn],face) then
							Add(queue,nn);
							Add(done,0);
							break;
						fi;
					od;
					for k in neighbors[current] do
						if IsSubset(facets[k],face) then
							ctr3 := ctr3 + 1;
							if done[Position(queue,k)] = 1 then
								Add(l,0);
								continue;
							fi;
							d := Difference(facets[k],face)[1];
							if not d in labeling then
								Add(labeling,d);
								Add(l,Size(labeling));
								ctr2:=ctr2+1;
							else
								Add(l,Position(labeling,d));
								ctr2:=ctr2+1;
							fi;
							done[Position(queue,k)] := 1;
							if minl <> [] and l[ctr3] > minl[ctr3] then
								next:=true;
								break;
							elif minl <> [] and l[ctr3] < minl[ctr3] then
								minl := [];
							fi;
						fi;
					od;
					if next then
						break;
					fi;
				od;
				if next then
					break;
				fi;
			od;
			if not next and (minl = [] or l < minl) then
				minl := l;
			fi;
		od;
	od;
	isosig:="";
	# store dimension
	Append(isosig,addNextValue(s));
	# for first d facets skip is always zero: omit these zeros
	for i in [1..s] do
		Append(isosig,addNextValue(minl[i]));
	od;
	# store rest of minl
	ctr2 := 0;
	for i in [s+1..Size(minl)] do
		if minl[i] = 0 then 
			# if skip, count number of skips
			ctr2 := ctr2+1;
		else
			# add skip and next value to isosig
			Append(isosig,addNextValue(ctr2));
			Append(isosig,addNextValue(minl[i]));
			ctr2 := 0;
		fi;
	od;
	return isosig;
end);


################################################################################
##<#GAPDoc Label="SCExportToString">
## <ManSection>
## <Func Name="SCExportToString" Arg="c"/>
## <Returns>string upon success, <K>fail</K> otherwise.</Returns>
## <Description>
## Computes one string representation of a closed and strongly connected weak 
## pseudomanifold. Compare <Ref Func="SCExportIsoSig" />, which returns the
## lexicographically minimal string representation.
## <Example>
## gap> c:=SCSeriesBdHandleBody(3,9);;
## gap> s:=SCExportToString(c); time;
## gap> s:=SCExportIsoSig(c); time;
## </Example>
## </Description>
## </ManSection>
##<#/GAPDoc>
################################################################################
InstallGlobalFunction(SCExportToString,
function(c)
	local i, j, k, n, nn, d, neighbors, facets, perm, l, queue, ctr, 
		ctr2, labeling, current, face, s, isosig, done,  
		addNextValue;

	if not SCIsSimplicialComplex(c) then
		Info(InfoSimpcomp,1,"SCExportToString: argument must be of type SCIsSimplicialComplex.");
		return fail;
	fi;

	if HasSCExportIsoSig(c) then
		return SCExportIsoSig(c);
	fi;

	if SCIsEmpty(c) then
		return ".";
	fi;

	if SCHasBoundary(c) or not SCIsStronglyConnected(c) or not SCIsPseudoManifold(c) then
		Info(InfoSimpcomp,1,"SCExportIsoSig: argument must be a strongly connected closed pseudomanifold.");
		return fail;
	fi;

	addNextValue:=function(val)
		local lut,str,ctr,prefix;
		lut := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ)!@#$%^&*(+.";
		str:="";
		if val = 0 then
			Add(str,lut[64]);
			return str;
		elif val > 0 and val < 64 then
			Add(str,lut[val]);
			return str;
		else
			ctr:=0;
			while val > 0 do
				ctr:=ctr+1;
				Add(str,lut[((val-1) mod 64)+1]);
				val := Int(val/64);
			od;
			prefix := ShallowCopy(String(ctr));
			str := Reversed(str);
			Append(prefix,str);
			return prefix;
		fi;
	end;

	facets := SCFacetsEx(c);
	if facets = fail then
		return fail;
	fi;
	n := Size(facets);
	s := Size(facets[1]);
	# build list of neighbors
	neighbors := [];
	for i in [1..n] do
		neighbors[i]:=[];
		for j in [1..n] do
			if i = j then continue; fi;
			if Size(Intersection(facets[i],facets[j])) = s-1 then
				Add(neighbors[i],j);
			fi;
		od;
	od;
	# calculate signature for standard labeling of first facet
	l := [];
	labeling := ShallowCopy(facets[1]);
	queue := [1];
	done := [1];
	ctr := 0;
	ctr2 := 0;
	while ctr2 < n-1 do
		ctr := ctr+1;
		current := queue[ctr];
		for j in labeling do
			if not j in facets[current] then continue; fi;
			face := ShallowCopy(facets[current]);
			Remove(face,Position(face,j));
			Sort(face);
			for nn in neighbors[current] do
				if nn in queue then continue; fi;
				if IsSubset(facets[nn],face) then
					Add(queue,nn);
					Add(done,0);
					break;
				fi;
			od;
			for k in neighbors[current] do
				if IsSubset(facets[k],face) then
					if done[Position(queue,k)] = 1 then
						Add(l,0);
						continue;
					fi;
					d := Difference(facets[k],face)[1];
					if not d in labeling then
						Add(labeling,d);
						Add(l,Size(labeling));
						ctr2:=ctr2+1;
					else
						Add(l,Position(labeling,d));
						ctr2:=ctr2+1;
					fi;
					done[Position(queue,k)] := 1;
				fi;
			od;
		od;
	od;
	isosig:="";
	# store dimension
	Append(isosig,addNextValue(s));
	# for first d facets skip is always zero: omit these zeros
	for i in [1..s] do
		Append(isosig,addNextValue(l[i]));
	od;
	# store rest of minl
	ctr2 := 0;
	for i in [s+1..Size(l)] do
		if l[i] = 0 then 
			# if skip, count number of skips
			ctr2 := ctr2+1;
		else
			# add skip and next value to isosig
			Append(isosig,addNextValue(ctr2));
			Append(isosig,addNextValue(l[i]));
			ctr2 := 0;
		fi;
	od;
	return isosig;
end);


################################################################################
##<#GAPDoc Label="SCFromIsoSig">
## <ManSection>
## <Meth Name="SCFromIsoSig" Arg="str"/>
## <Returns>a SCSimplicialComplex object upon success, <K>fail</K> otherwise.</Returns>
## <Description>
## Computes a simplicial complex from its isomorphism signature. If a file with
## isomorphism signatures is provided a list of all complexes is returned.
## <Example>
## gap> s:="deeee";;
## gap> c:=SCFromIsoSig(s);;
## gap> SCIsIsomorphic(c,SCBdSimplex(4));
## </Example>
## <Example>
## gap> s:="deeee";;
## gap> PrintTo("tmp.txt",s,"\n");;
## gap> cc:=SCFromIsoSig("tmp.txt");
## gap> cc[1].F;
## </Example>
## </Description>
## </ManSection>
##<#/GAPDoc>
################################################################################
InstallMethod(SCFromIsoSig,
"for String",
[IsString],
function(str)
	local sig, i, size, ctr1, ctr2, done, new, facets, comb, skip, val, tmp,
		s, getNextValue, c, cc, l;

	if IsExistingFile(str) then
		s := InputTextFile(str);
		l := ReadLine(s);
		cc :=[];
		while l <> fail do
			if l{[Size(l)]} <> "\n" then
				Info(InfoSimpcomp,1,"SCFromIsoSig: cannot read file format, line ended without newline.\n");
				return fail;
			fi;
			l := l{[1..Size(l)-1]};
			Add(cc,SCFromIsoSig(l));
			l :=ReadLine(s);
		od;
		return cc;
	fi;

	getNextValue:=function(str,idx)
		local lut,val,ctr,power,tmp,pos;
		lut := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ)!@#$%^&*(+.";
		if Int(str{[idx]}) = fail then
			pos:=Position(lut,str[idx]);
			if pos = fail then
				Info(InfoSimpcomp,1,"SCFromIsoSig: invalid isomorphism signature provided.\n");
				return fail;
			fi;
			return [pos mod 64,idx+1];
		else
			val:=0;
			ctr := idx;
			while Int(str{[ctr]}) <> fail do
				ctr:=ctr+1;
			od;
			power:=Int(str{[idx..ctr-1]});
			for i in [1..power] do
				pos:=Position(lut,str[ctr]);
				if pos = fail then
					Info(InfoSimpcomp,1,"SCFromIsoSig: invalid isomorphism signature provided.\n");
					return fail;
				fi;
				val := val + (pos mod 64)*64^(power-i);
				ctr:=ctr+1;
			od;
			return [val,ctr];
		fi;
	end;

	if str = "" then
		Info(InfoSimpcomp,1,"SCFromIsoSig: isomorphism signature is empty.\n");
		return fail;
	fi;

	if str = "." then
		return SCEmpty();
	fi;

	sig:=[];
	tmp:=getNextValue(str,1);
	if tmp = fail then
		return fail;
	fi;
	size := tmp[1];
	ctr1 := tmp[2];
	facets:=[[1..size]];
	for i in [1..size] do
		Add(sig,0);
		tmp:=getNextValue(str,ctr1);
		if tmp = fail then
			return fail;
		fi;
		val := tmp[1];
		ctr1 := tmp[2];
		Add(sig,val);
	od;
	while ctr1 <= Size(str) do
		tmp:=getNextValue(str,ctr1);
		if tmp = fail then
			return fail;
		fi;
		val := tmp[1];
		ctr1 := tmp[2];
		Add(sig,val);
	od;
	ctr1:=1;
	ctr2:=1;
	done:=false;
	skip:=true;
	while not done do
		for comb in Reversed(Combinations(facets[ctr1],size-1)) do
			if skip then
				if ctr2 >= Size(sig) then
					done:=true;
					break;
				fi;
				if sig[ctr2] > 0 then
					sig[ctr2] := sig[ctr2]-1;
					continue;
				else
					ctr2 := ctr2+1;
					skip := false;
				fi;
			fi;
			if not skip then
				new:=Concatenation(comb,[sig[ctr2]]);
        Sort(new);
				Add(facets,new);
				ctr2:=ctr2+1;
				skip := true;
				if ctr2 > Size(sig) then
					done:=true;
					break;
				fi;
			fi;
		od;
		if not done then ctr1:=ctr1+1; fi;
	od;

	c := SCFromFacets(facets);

  if c = fail then
    Print(facets,"\n");    
  fi;

	SetSCExportIsoSig(c,str);

	return c;
end);