|
#(C) Graham Ellis, 2005-2006
#####################################################################
#####################################################################
InstallGlobalFunction(IsAspherical,
function(arg)
local
F,Frels,G,
Vertices,
CollEdges,
Edges,
RelatorToVertices,
RelatorToEdges,
BoundaryMat,
BoundaryKer,
Vector,
EqualitiesMat,
EqualitiesVec,
InEqualities,
InEqSizes,
Polymake,
tmpdir, tmpin, tmpodir, tmpout,
L,r,
AppendTo, PrintTo,
R,Redges,V,ii,bol, sm, i,x,row,n,m,M;
AppendTo:=HAP_AppendTo;
PrintTo:=HAP_PrintTo;
tmpdir := DirectoryTemporary();;
tmpin:=Filename( tmpdir , "tmpIn.log" );
tmpodir := DirectoryTemporary();;
tmpout:=Filename( tmpdir , "tmpOut.log" );
if Length(arg)=2 then F:=arg[1]; Frels:=arg[2]; fi;
if Length(arg)=1 then
G:=arg[1];
F:=FreeGroupOfFpGroup(G); Frels:=RelatorsOfFpGroup(G); fi;
Frels:=List(Frels,r->CyclicallyReducedWord(r));
Vertices:=[];
CollEdges:=[];
Edges:=[];
#####################################################################
RelatorToVertices:=function(R);
return SSortedList(LetterRepAssocWord(R));
end;
#####################################################################
for R in Frels do
UniteSet(Vertices, RelatorToVertices(R));
UniteSet(Vertices, -1*RelatorToVertices(R));
od;
#####################################################################
RelatorToEdges:=function(R)
local Rvertices, Redges, u,v,i;
Rvertices:=LetterRepAssocWord(R);
Redges:=[];
for i in [1..(Length(Rvertices)-1)] do
u:=Rvertices[i];
v:=-Rvertices[i+1];
Append(Redges,[ SortedList([u,v]) ]);
od;
u:=Rvertices[Length(Rvertices)];
v:=-Rvertices[1];
Append(Redges,[ SortedList([u,v]) ]);
return Redges;
end;
####################################################################
for R in Frels do
Append(CollEdges, RelatorToEdges(R));
od;
CollEdges:=Collected(CollEdges);
Edges:=List(CollEdges,x->x[1]);
BoundaryMat:=[];
for x in Edges do
row:=List([1..Length(Vertices)],i->0);
row[Position(Vertices,x[1])]:=1;
row[Position(Vertices,x[2])]:=1;
Append(BoundaryMat,[row]);
od;
#EQUATIONS
EqualitiesMat:=[];
EqualitiesVec:=[];
for R in Frels do
M:=[];
Redges:=RelatorToEdges(R);
n:=Length(LetterRepAssocWord(R));
row:=List([1..Length(Edges)+1],i->0);
for x in Redges do
m:=Position(Edges,x);
row[m]:=row[m]+1;
od;
row[Length(Edges)+1]:=n-2;
for x in [1..Length(Edges)] do
Append(M,[row[x]]);
od;
Append(EqualitiesMat,[M]);
Append(EqualitiesVec,[n-2]);
od;
#Vector:=SolutionMat(TransposedMat(EqualitiesMat),EqualitiesVec);
#INEQUALITIES
InEqualities:=NullspaceModQ(BoundaryMat,2); #THIS IS CLUMSY!!
InEqualities:=Filtered(InEqualities,r->not IsZero(r));
###MODIFIED AUG 2016
#SortBy(InEqualities,Sum);
#L:=InEqualities;
#for ii in [1..Minimum(1000,Length(InEqualities))] do
##ANF WHY 1000??
#sm:=Sum(InEqualities[ii]);
#L:=Filtered(L,r->r*InEqualities[ii]<sm or r=InEqualities[ii]);
#od;
#InEqualities:=L;
###MODIFICATION STOPS HERE
InEqSizes:=List(InEqualities,x->Sum(x));
for i in [1..2*LogInt(Length(InEqualities)+1,2)] do
m:=Position(InEqSizes,Minimum(InEqSizes));
InEqSizes[m]:=Maximum(InEqSizes)+1;
V:=InEqualities[m];
if not V=0 then
for x in [1..Length(InEqualities)] do
if V*InEqualities[x]=Sum(V) and (not x=m) then
InEqualities[x]:=0; fi;
od;
fi;
od;
InEqualities:=Filtered(InEqualities,x->not x=0);
for x in CollEdges do
if x[2]>1 then
V:=List([1..Length(Edges)],i->0);
V[Position(Edges,x[1])]:=2;
Append(InEqualities,[V]);
fi;
od;
#####################################################################
Polymake:=function()
local V, i, x, input;
AppendTo(tmpin,"EQUATIONS","\n");
for i in [1..Length(EqualitiesMat)] do
AppendTo(tmpin,-EqualitiesVec[i]," ");
for x in [1..Length(EqualitiesMat[1])] do
AppendTo(tmpin,EqualitiesMat[i][x]," ");
od;
AppendTo(tmpin,"\n");
od;
AppendTo(tmpin,"\n","INEQUALITIES","\n");
for i in [1..Length(InEqualities)] do
AppendTo(tmpin,-2," ");
for x in [1..Length(InEqualities[1])] do
AppendTo(tmpin,InEqualities[i][x]," ");
od;
AppendTo(tmpin,"\n");
od;
for i in [1..Length(InEqualities[1])] do
AppendTo(tmpin,0," ");
for x in [1..Length(InEqualities[1])] do
if i=x then AppendTo(tmpin,1," ");
else AppendTo(tmpin,0," "); fi;
od;
AppendTo(tmpin,"\n");
od;
Exec(Concatenation("polymake ", "'my $c=load(\"",tmpin,"\"); print $c-> FEASIBLE;' > ",tmpout));
Exec(Concatenation("rm ",tmpin));
input := InputTextFile(tmpout);
x:=ReadLine(input);
Exec(Concatenation("rm ",tmpout));
return x;
end;
#####################################################################
x:= Polymake();
if x="true" then
Print("Presentation is aspherical.\n\n"); return true;
else
Print("Test inconclusive.\n\n");
return fail; fi;
end);
#####################################################################
#####################################################################
#####################################################################
#####################################################################
InstallMethod(StarGraph, "For FPGroups", [IsFpGroup], StarGraphAttr);
InstallMethod(StarGraphAttr,
"For FpGroups",
[IsFpGroup],
function(G)
local
F,Frels,Vertices,
CollEdges,
Edges,
RelatorToVertices,
RelatorToEdges,
A,R,i,j,x;
F:=FreeGroupOfFpGroup(G);;
Frels:=RelatorsOfFpGroup(G);;
Frels:=List(Frels,r->CyclicallyReducedWord(r));
Vertices:=[];
CollEdges:=[];
Edges:=[];
#####################################################################
RelatorToVertices:=function(R);
return SSortedList(LetterRepAssocWord(R));
end;
#####################################################################
for R in Frels do
UniteSet(Vertices, RelatorToVertices(R));
UniteSet(Vertices, -1*RelatorToVertices(R));
od;
#####################################################################
RelatorToEdges:=function(R)
local Rvertices, Redges, u,v,i;
Rvertices:=LetterRepAssocWord(R);
Redges:=[];
for i in [1..(Length(Rvertices)-1)] do
u:=Rvertices[i];
v:=-Rvertices[i+1];
Append(Redges,[ SortedList([u,v]) ]);
od;
u:=Rvertices[Length(Rvertices)];
v:=-Rvertices[1];
Append(Redges,[ SortedList([u,v]) ]);
return Redges;
end;
####################################################################
for R in Frels do
Append(CollEdges, RelatorToEdges(R));
od;
CollEdges:=Collected(CollEdges);
Edges:=List(CollEdges,x->x[1]);
A:=NullMat(Length(Vertices),Length(Vertices));
for x in CollEdges do
i:=Position(Vertices,x[1][1]);
j:=Position(Vertices,x[1][2]);
A[i][j]:=Minimum(2,A[i][j]+x[2]);A[j][i]:=Minimum(2,A[j][i]+x[2]);
od;
return IncidenceMatrixToGraph(A);
end);
#####################################################################
#####################################################################
[ Dauer der Verarbeitung: 0.39 Sekunden
(vorverarbeitet)
]
|
