#(C) Graham Ellis, 2005-2006


#####################################################################
InstallGlobalFunction(ResolutionFiniteGroup,
function(arg)

local
	Gens,
	K,
	tietze,
	G,
	Elts, ExtendedElts, 
	N,
	MT,
	Mult,
	Action,
	ChangeSign,
	Abs,
	MaxComplex,
	Dimension,
	Boundary,
	PseudoBoundary,
	ContractionMatrix,
	Contraction,
	Homotopy,
	ComputedContractions,
	Differential,
	CellValue,
	FirstZero,
	IsFinished,
	FindConsequences,
	NextResTerm,
	Spheres,
	DiffLengths,
	InitComputedContractions,
	saveSpace,
	Charact,
	AlgebraicRed,
	i, ii;


if IsGroup(arg[1]) then Gens:=GeneratorsOfGroup(arg[1]);
if Length(Gens)=0 then Gens:=[Identity(arg[1])]; fi;
else Gens:=arg[1]; fi;
Gens:=SSortedList(StructuralCopy(Gens));
K:=StructuralCopy(arg[2]);
if Length(arg)>2 then tietze:=arg[3]; else tietze:=false; fi;

if Length(arg)>3 then 
		if IsInt(arg[4]) then Charact:=arg[4]; fi;
else Charact:=0; fi;

if Length(arg)>4 then saveSpace:=arg[5]; else saveSpace:=false; fi;

G:=Group(Gens);
N:=Order(G);
Elts:=[];
for i in Elements(G) do
Append(Elts,[i]);
od;
i:=Position(Elts,Identity(G));
Elts[i]:=Elts[1];
Elts[1]:=Identity(G);
RemoveSet(Gens,Identity(G));

ExtendedElts:=List(Gens,g->Position(Elts,g));	
Append(ExtendedElts,[1..N]);			

if Charact=0 then AlgebraicRed:=AlgebraicReduction;
else
	AlgebraicRed:=function(w);
	return AlgebraicReduction(w,Charact);
	end;
fi;

if Order(G)<4096  then
MT:=MultiplicationTable(Elts);

#####################################################################
Mult:=function(i,j);
return MT[i][j]; 
end;
#####################################################################

else

#####################################################################
Mult:=function(i,j);
return Position(Elts,Elts[i]*Elts[j]);
end;
#####################################################################

fi;

#####################################################################
Action:=function(g,l);
return [l[1],Mult(g,l[2])];
end;
#####################################################################

#####################################################################
ChangeSign:=function(j,b);
if j>0 then return b; else 
return NegateWord(b); fi;
end;
#####################################################################

#####################################################################
Abs:=function(l)
local r;
r:=ShallowCopy(l);
Apply(r,x->[AbsoluteValue(x[1]),x[2]]);
return r;
end;
#####################################################################

#####################################################################
MaxComplex:=[];
MaxComplex[1]:=[[1..N]];
Apply(MaxComplex[1][1],i->0);
MaxComplex[1][1][1]:=1;
PseudoBoundary:=[];
ContractionMatrix:=[];
ComputedContractions:=[];
#####################################################################

#####################################################################
Dimension:=function(i);
if i<0 then return 0; fi;
if i=0 then return 1; fi;
return Length(PseudoBoundary[i]); 
end;
#####################################################################

#####################################################################
Boundary:=function(i,j);
if i=0 then return []; else 
return ChangeSign(j,PseudoBoundary[i][AbsoluteValue(j)]); fi;
end;
#####################################################################

#####################################################################
CellValue:=function(i,MC,p)		#MC=MaxComplex[i]
local x,l,v,e,q;

l:=ShallowCopy(Boundary(i,p[1]));
Apply(l,x->Action(p[2],x));
v:=Length(l);				#l is the boundary of cell p
					#where p has dimension i.
for e in l do
v:=v-MC[AbsoluteValue(e[1])][e[2]];
od;

q:=0;
if v = 1 then 
for x in l do
if MC[AbsoluteValue(x[1])][x[2]] = 0 then q:=x; break; fi;
od;
fi;

if tietze then
   if (v = 0)  then Append(Spheres,[l]);fi;	
fi;						#Spheres is a list of contractible
						#spheres. 
return [v,q];
end;
#####################################################################

#####################################################################
FirstZero:=function(MC)
local j,g, temp, temp2, compare, p,q, LengthOfDiff;

temp:=[];

for j in [1..Length(MC)] do
for g in [1..N] do
if MC[j][g]=0 then Append(temp,[ [j,g]]);
fi;
od;
od;

LengthOfDiff:=function(p);
if DiffLengths[p[1]][p[2]]=0 then 
DiffLengths[p[1]][p[2]]:=Length(Differential(i,p)); fi;
return DiffLengths[p[1]][p[2]];
end;

temp2:=List(temp, LengthOfDiff );

return temp[Position(temp2,Minimum(temp2))];

end;
#####################################################################

#####################################################################
IsFinished:=function(MC);
if Product(Flat(MC)) = 1 then return true; 
else return false; fi;
end;
#####################################################################

#####################################################################
Contraction:=function(i,x)		#x is an (i-1)-cell and the output
local l,m,b,c,y,z;			#is a collection of i-cells. For technical
					#reasons we need to allow i=0. The sign factors
if i<1 then return [[-1,1]]; else	#in the function were arrived at by trial and
					#error, rather than mathematical reasoning!
					#When Contraction computes a value for (i,x)
					#it stores it in ComputedContractions[i] and uses
					#this computed value subsequently.
					
   if ComputedContractions[i][AbsoluteValue(x[1])][x[2]]=0 then
   z:=[AbsoluteValue(x[1]),x[2]];
      if ContractionMatrix[i][z[1]][z[2]]=1 then return []; 
      else
      m:=ContractionMatrix[i][z[1]][z[2]];
      b:=ShallowCopy(Boundary(i,m[1]));
      Apply(b,y-> Action(m[2],y));
      b:=ChangeSign(-x[1],b);

      c:=ChangeSign(-x[1],[m]);
      for y in b do
         if (not Abs([y])=Abs([x])) 
         then Append(c,Contraction(i,y));
         fi;
      od;

      if i<K then ComputedContractions[i][z[1]][z[2]]:=ChangeSign(x[1],c); fi; 	
      return c;
      fi;
   else

   c:=ComputedContractions[i][AbsoluteValue(x[1])][x[2]];
   return ChangeSign(x[1],c);
   fi;

fi;
end;
#####################################################################

#####################################################################
Homotopy:=function(i,p); 	#It is useful to have a second name
if i <0 then return fail; fi;	#for Contraction with the correct indexing!
return ChangeSign(-1,Contraction(i+1,p));	
end;
#####################################################################

#####################################################################
Differential:=function(i,p)  	#The boundary of an i-cell corresponding
local j,k,l,x,Diff;		#to an (i-1)-cell p in MaxComplex. The cell
				#p itself should be in the boundary.
j:=p[1];
k:=p[2];
Diff:=[p];
if i=1 then l:=[1]; else
l:=ShallowCopy(PseudoBoundary[i-1][AbsoluteValue(j)]); 
Apply(l,x->Action(k,x));	#l is the boundary of p.
l:=ChangeSign(j,l);
fi;

for x in l do
Append(Diff,Contraction(i-1,x)); 
od;

return Diff;
end;
#####################################################################

#####################################################################
FindConsequences:=function(i,MC)  	#MC=StructuralCopy(MacComplex[i])
local j,g,c,p,toggle;
toggle:=true;

if i<K then
while toggle do
toggle:=false;
for g in ExtendedElts do
for j in [1..Dimension(i)] do
c:=CellValue(i,MC,[j,g]); p:=c[2];
if c[1]=1 then MC[AbsoluteValue(p[1])][p[2]]:=1;
ContractionMatrix[i][AbsoluteValue(p[1])][p[2]]:=[SignInt(p[1])*j,g];
MaxComplex[i+1][j][g]:=1;
toggle:=true;fi;
od;
od;
od;

else

while toggle do
toggle:=false;
for g in ExtendedElts do
for j in [1..Dimension(i)] do
c:=CellValue(i,MC,[j,g]); p:=c[2];
if c[1]=1 then MC[AbsoluteValue(p[1])][p[2]]:=1;
MaxComplex[i+1][j][g]:=1;
toggle:=true;fi;
od;
od;
od;

fi;
end;
#####################################################################

#####################################################################
InitComputedContractions:=function(i)
local ii,j;

ComputedContractions[i]:=[];
for ii in [1..Dimension(i-1)] do
ComputedContractions[i][ii]:=[];
for j in [1..N] do
ComputedContractions[i][ii][j]:=0;
od;
od;

end;
#####################################################################

#####################################################################
NextResTerm:=function(i)
local p, MC,l,j,Diff;
PseudoBoundary[i]:=[];
MaxComplex[i+1]:=[];
ContractionMatrix[i]:=ShallowCopy(MaxComplex[i]);
MC:=StructuralCopy(MaxComplex[i]);
Spheres:=[];
DiffLengths:=[];

for ii in [1..Length(MC)] do
DiffLengths[ii]:=[];
for j in [1..N] do
DiffLengths[ii][j]:=0;
od;
od;

InitComputedContractions(i); 

l:=[1..N];Apply(l,x->0);l[1]:=1;

if i<K then
while not IsFinished(MC) do
p:=FirstZero(MC);
if tietze then 
   Diff:=TietzeReduction(Spheres,AlgebraicRed((Differential(i,p))));
else
   Diff:=AlgebraicRed(Differential(i,p));
fi;
Append(PseudoBoundary[i],[Diff]);
Append(MaxComplex[i+1],[ShallowCopy(l)]);
MC[p[1]][p[2]]:=1;
ContractionMatrix[i][p[1]][p[2]]:=[Length(MaxComplex[i+1]),1];
FindConsequences(i,MC);
od;

else

while not IsFinished(MC) do
p:=FirstZero(MC);
if tietze then
Diff:=TietzeReduction(Spheres,AlgebraicRed((Differential(i,p))));
else
Diff:=AlgebraicRed(Differential(i,p));
fi;

#if IsPrimeInt(Charact) then
#Diff:=WordModP(Diff,Charact);
#fi;                              #I'm not sure about the maths of this.

Append(PseudoBoundary[i],[Diff]);
Append(MaxComplex[i+1],[ShallowCopy(l)]);
MC[p[1]][p[2]]:=1;
FindConsequences(i,MC);
od;

fi;

DiffLengths:=0; MC:=0;
end;
#####################################################################


for i in [1..K] do
NextResTerm(i);
MaxComplex[i]:=[];
if i>1 and saveSpace then InitComputedContractions(i-1); fi;
od;

return Objectify(HapResolution,
		rec(
		dimension:=Dimension,
		boundary:=Boundary,
		homotopy:=Homotopy,
		elts:=Elts,
		group:=G,
		properties:=
		   [["length",K],
		    ["reduced",true],
		    ["type","resolution"],
		    ["characteristic",Charact]  ])); 
end);
#####################################################################
