|
###############################################################################
##
## 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><![CDATA[
## 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><![CDATA[
## 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><![CDATA[
## gap> s:="deeee";;
## gap> c:=SCFromIsoSig(s);;
## gap> SCIsIsomorphic(c,SCBdSimplex(4));
## ]]></Example>
## <Example><![CDATA[
## 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);
[ Dauer der Verarbeitung: 0.33 Sekunden
(vorverarbeitet)
]
|
