1################################################################################
2##
3##  simpcomp / generate.gi
4##
5##  Generate simplicial complexes or construct them using existing
6##  complexes.
7##
8##  $Id$
9##
10################################################################################
11
12#checks if labels of a facet list are valid
13SCIntFunc.HasValidLabels:=
14function(facets)
15
16	local i,j;
17
18	for j in [1..Size(facets)] do
19		for i in facets[j] do
20			if IsRat(i) or IsCyclotomic(i) or IsFFE(i) or IsPerm(i) or IsBool(i) or IsChar(i) or IsList(i) then
21				continue;
22			else
23				Info(InfoSimpcomp,1,"SCIntFunc.HasValidLabels: vertex labels have to be rationals, cyclotomics, finite field elements, permutations, characters, lists or strings");
24				return false;
25			fi;
26		od;
27	od;
28	return true;
29
30end;
31
32#checks if facet list is valid
33SCIntFunc.IsValidFacetList:=
34function(facets)
35	if(not IsList(facets) or not IsDuplicateFreeList(facets) or not ForAll(facets,x->IsList(x) and IsDuplicateFree(x)) or not SCIntFunc.HasValidLabels(facets)) then
36		return false;
37	else
38		return true;
39	fi;
40end;
41
42#extract dimension of facet list
43SCIntFunc.GetFacetListDimension:=
44function(facets)
45	if facets<>[] then
46		return MaximumList(List(facets,x->Length(x)))-1;
47	else
48		return -1;
49	fi;
50end;
51
52
53#recursive function to make deep (i.e. full) copies of objects
54SCIntFunc.DeepCopy:=
55function(obj)
56	local tmprec,key,scnew,i,cobj;
57	if(SCIsSimplicialComplex(obj)) then
58		scnew:=SCIntFunc.SCNew();
59		scnew!.Properties:=SCIntFunc.DeepCopy(obj!.Properties);
60		scnew!.PropertiesTmp:=SCIntFunc.DeepCopy(obj!.PropertiesTmp);
61		return scnew;
62	elif(IsRecord(obj)) then
63		tmprec:=rec();
64		for key in RecNames(obj) do
65			tmprec.(key):=SCIntFunc.DeepCopy(obj.(key));
66		od;
67		return tmprec;
68	elif(not IsList(obj)) then
69		return ShallowCopy(obj);
70	elif(ForAll(obj,x->not IsList(x))) then
71		return ShallowCopy(obj);
72	else
73		cobj:=[];
74
75		for i in [1..Length(obj)] do
76			if not IsBound(obj[i]) then
77				continue;
78			fi;
79
80			cobj[i]:=SCIntFunc.DeepCopy(obj[i]);
81		od;
82		return cobj;
83	fi;
84end;
85
86
87#apply a function "deeply" on a list
88SCIntFunc.DeepList:=function(list,func)
89	if not IsList(list) or (IsList(list) and not ForAny(list,IsList)) then
90		return func(list);
91	else
92		return List(list,x->SCIntFunc.DeepList(x,func));
93	fi;
94end;
95
96#deep sort a list
97SCIntFunc.DeepSortList:=function(list)
98	if not IsList(list) then
99		return;
100	elif ForAll(list,x->not IsList(x) or IsStringRep(x)) then
101		Sort(list);
102	else
103		Perform(list,SCIntFunc.DeepSortList);
104		Sort(list);
105	fi;
106end;
107
108
109################################################################################
110##<#GAPDoc Label="SCFromGenerators">
111## <ManSection>
112## <Meth Name="SCFromGenerators" Arg="group, generators"/>
113## <Returns>simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
114## <Description>
115## Constructs a simplicial complex object from the set of <Arg>generators</Arg> on which the group <Arg>group</Arg> acts, i.e. a complex which has <Arg>group</Arg> as a subgroup of the automorphism group and a facet list that consists of the <Arg>group</Arg>-orbits specified by the list of representatives passed in <Arg>generators</Arg>. Note that <Arg>group</Arg> is not stored as an attribute of the resulting complex as it might just be a subgroup of the actual automorphism group. Internally calls <C>Orbits</C> and <Ref Func="SCFromFacets" />.
116## <Example>
117## gap> #group: AGL(1,7) of order 42
118## gap> G:=Group([(2,6,5,7,3,4),(1,3,5,7,2,4,6)]);;
119## gap> c:=SCFromGenerators(G,[[ 1, 2, 4 ]]);
120## [SimplicialComplex
121##
122##  Properties known: Dim, Facets, Name, VertexLabels.
123##
124##  Name="unnamed complex m"
125##  Dim=2
126##
127## /SimplicialComplex]
128## gap> SCLib.DetermineTopologicalType(c);
129## [ [ true, 5 ] ] # the 7-vertex torus
130## </Example>
131## </Description>
132## </ManSection>
133##<#/GAPDoc>
134################################################################################
135InstallMethod(SCFromGenerators,
136"for Group and List",
137[IsPermGroup,IsList],
138function(group,generators)
139	local complex,facets,os,g,vertices,newGens,ggens,newGGens,len;
140
141	if not IsDuplicateFreeList(generators) or IsEmpty(generators) then
142		Info(InfoSimpcomp,1,"SCFromGenerators: first argument must be a group in permutation representation, second a nonempty list of generators.");
143		return fail;
144	fi;
145
146	os:=Orbits(group,generators,OnSets);
147	facets:=Union(os);
148	len:=List(os,x->Size(x));
149
150	if(not SCIntFunc.IsValidFacetList(facets)) then
151		Info(InfoSimpcomp,1,"SCFromGenerators: group operation yields invalid facet list!");
152		return fail;
153	fi;
154
155	complex:=SCFromFacets(facets);
156	if(complex=fail) then
157		return fail;
158	fi;
159
160	#vertices:=SCVertices(complex);
161	#if vertices = fail then
162	#	return fail;
163	#fi;
164
165	#if Size(group) = 1 then
166	#	g:=Group(());
167	#else
168	#	ggens:=GeneratorsOfGroup(group);
169	#	newGGens:=List(ggens,x->SCIntFunc.RelabelPermutation(x,vertices));
170	#	g:=Group(newGGens);
171	#fi;
172
173	#newGens:=SCIntFunc.RelabelSimplexListInv(generators,vertices);
174
175	#SetSCAutomorphismGroup(complex,g);
176	#SetSCAutomorphismGroupSize(complex,Size(g));
177	#SetSCAutomorphismGroupStructure(complex,StructureDescription(g));
178	#SetSCAutomorphismGroupTransitivity(complex,Transitivity(g));
179	#SetSCGeneratorsEx(complex,List(newGens,x->[x,len[Position(newGens,x)]]));
180
181	if HasStructureDescription(group) then
182		SCRename(complex, Concatenation("complex from generators under group ",StructureDescription(group)));
183	elif HasName(group) then
184		SCRename(complex, Concatenation("complex from generators under group ",Name(group)));
185	else
186		SCRename(complex,"complex from generators under unknown group");
187	fi;
188
189
190	return complex;
191end);
192
193
194################################################################################
195##<#GAPDoc Label="SCFromFacets">
196## <ManSection>
197## <Meth Name="SCFromFacets" Arg="facets"/>
198## <Returns>simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
199## <Description>
200## Constructs a simplicial complex object from the given facet list. The facet list <Arg>facets</Arg> has to be a duplicate free list (or set) which consists of duplicate free entries, which are in turn lists or sets. For the vertex labels (i. e. the entries of the list items of <Arg>facets</Arg>) an ordering via the less-operator has to be defined. Following Section 4.11 of the &GAP; manual this is the case for objects of the following families: rationals <C>IsRat</C>, cyclotomics <C>IsCyclotomic</C>, finite field elements <C>IsFFE</C>, permutations <C>IsPerm</C>, booleans <C>IsBool</C>, characters <C>IsChar</C> and lists (strings) <C>IsList</C>.<P/>
201## Internally the vertices are mapped to the standard labeling <M>1..n</M>, where <M>n</M> is the number of vertices of the complex and the vertex labels of the original complex are stored in the property ''VertexLabels'', see <Ref Func="SCLabels" /> and the <C>SCRelabel..</C> functions like <Ref Func="SCRelabel" /> or <Ref Func="SCRelabelStandard" />.
202## <Example>
203## gap> c:=SCFromFacets([[1,2,5], [1,4,5], [1,4,6], [2,3,5], [3,4,6], [3,5,6]]);
204## gap> c:=SCFromFacets([["a","b","c"], ["a","b",1], ["a","c",1], ["b","c",1]]);
205## </Example>
206## </Description>
207## </ManSection>
208##<#/GAPDoc>
209################################################################################
210InstallMethod(SCFromFacets,
211"for List",
212[IsList],
213function(facets)
214	local lfacets,obj,dim,known,vertices,i,j,idx;
215
216	if(not SCIntFunc.IsValidFacetList(facets)) then
217		Info(InfoSimpcomp,1,"SCFromFacets: invalid facet list!");
218		return fail;
219	fi;
220
221	dim:=SCIntFunc.GetFacetListDimension(facets);
222
223	if(dim=-1) then
224		obj:=SCEmpty();
225	else
226		lfacets:=Set(SCIntFunc.DeepCopy(facets));
227		Perform(lfacets,Sort);
228		Sort(lfacets);
229
230		vertices:=Union(lfacets);
231		for i in [1..Size(lfacets)] do
232			for j in [1..Size(lfacets[i])] do
233				idx:=Position(vertices,lfacets[i][j]);
234				if idx<>fail then
235					lfacets[i][j]:=idx;
236				else
237					Info(InfoSimpcomp,1,"SCFromFacets: error in vertex index.");
238					return fail;
239				fi;
240			od;
241		od;
242
243		obj:=SCIntFunc.SCNew();
244		SetSCVertices(obj,vertices);
245		SetSCDim(obj,dim);
246		SetSCFacetsEx(obj,lfacets);
247		SetSCName(obj,Concatenation("unnamed complex ",String(SCSettings.ComplexCounter)));
248
249		SCSettings.ComplexCounter:=SCSettings.ComplexCounter+1;
250	fi;
251
252	return obj;
253end);
254
255
256################################################################################
257##<#GAPDoc Label="SC">
258## <ManSection>
259## <Meth Name="SC" Arg="facets"/>
260## <Returns>simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
261## <Description>
262## A shorter function to create a simplicial complex from a facet list, just calls <Ref Func="SCFromFacets" Style="Text"/>(<Arg>facets</Arg>).
263## <Example>
264## gap> c:=SC(Combinations([1..6],5));
265## [SimplicialComplex
266##
267##  Properties known: Dim, Facets, VertexLabels.
268##
269##  Name="unnamed complex m"
270##  Dim=4
271##
272## /SimplicialComplex]
273## </Example>
274## </Description>
275## </ManSection>
276##<#/GAPDoc>
277################################################################################
278InstallMethod(SC,
279"for List",
280[IsList],
281function(facets)
282	return SCFromFacets(facets);
283end);
284
285
286################################################################################
287##<#GAPDoc Label="SCEmpty">
288## <ManSection>
289## <Func Name="SCEmpty" Arg=""/>
290## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
291## <Description>
292## Generates an empty complex (of dimension <M>-1</M>), i. e. a <C>SCSimplicialComplex</C> object with empty facet list.
293## <Example>
294## gap> SCEmpty();
295## [SimplicialComplex
296##
297##  Properties known: Dim, Faces, Facets, Name, VertexLabels.
298##
299##  Name="empty complex"
300##  Dim=-1
301##
302## /SimplicialComplex]
303## </Example>
304## </Description>
305## </ManSection>
306##<#/GAPDoc>
307################################################################################
308InstallGlobalFunction(SCEmpty,
309function()
310	local obj;
311
312	obj:=SCIntFunc.SCNew();
313	SetSCVertices(obj,[]);
314	SetSCDim(obj,-1);
315	SetSCFacetsEx(obj,[]);
316	SetSCName(obj,"empty complex");
317	SetFilterObj(obj,IsEmpty);
318
319	return obj;
320end);
321
322
323##########################
324## <#GAPDoc Label="SCFVectorBdCrossPolytope">
325## <ManSection>
326## <Func Name="SCFVectorBdCrossPolytope" Arg="d"/>
327## <Returns> a list of integers of size <C>d + 1</C> upon success, <K>fail</K> otherwise.</Returns>
328## <Description>
329## Computes the <M>f</M>-vector of the <M>d</M>-dimensional cross polytope without generating the underlying complex.
330## <Example>
331## gap> SCFVectorBdCrossPolytope(50);
332## [100, 4900, 156800, 3684800, 67800320, 1017004800, 12785203200,
333##   137440934400, 1282782054400, 10518812846080, 76500457062400,
334##   497252970905600, 2907017368371200, 15365663232819200, 73755183517532160,
335##   322678927889203200, 1290715711556812800, 4732624275708313600,
336##   15941471244491161600, 49418560857922600960, 141195888165493145600,
337##   372243705163572838400, 906332499528699084800, 2039248123939572940800,
338##   4241636097794311716864, 8156992495758291763200, 14501319992459185356800,
339##   23823597130468661657600, 36146147370366245273600, 50604606318512743383040,
340##   65296266217435797913600, 77539316133205010022400, 84588344872587283660800,
341##   84588344872587283660800, 77337915312079802204160, 64448262760066501836800,
342##   48771658304915190579200, 33370081998099867238400, 20535435075753764454400,
343##   11294489291664570449920, 5509506971543692902400, 2361217273518725529600,
344##   878592473867432755200, 279552150776001331200, 74547240206933688320,
345##   16205921784116019200, 2758454771764428800, 344806846470553600,
346##   28147497671065600, 1125899906842624]
347## </Example>
348## </Description>
349## </ManSection>
350## <#/GAPDoc>
351##########################
352InstallGlobalFunction(SCFVectorBdCrossPolytope,
353function(d)
354	local F,i;
355
356	if(d<=0) then
357		Info(InfoSimpcomp,1,"SCFVectorBdCrossPolytope: dimension must be positive.");
358		return fail;
359	fi;
360
361	F:=ListWithIdenticalEntries(d,0);
362
363	for i in [1..d] do
364		F[i]:=(2^i)*Binomial(d,i);
365	od;
366
367	return F;
368
369end);
370
371
372##########################
373## <#GAPDoc Label="SCFVectorBdCyclicPolytope">
374## <ManSection>
375## <Func Name="SCFVectorBdCyclicPolytope" Arg="d, n"/>
376## <Returns> a list of integers of size <C>d+1</C> upon success, <K>fail</K> otherwise.</Returns>
377## <Description>
378## Computes the <M>f</M>-vector of the <Arg>d</Arg>-dimensional cyclic polytope on <Arg>n</Arg> vertices, <M>n\geq d+2</M>, without generating the underlying complex.
379## <Example>
380## gap> SCFVectorBdCyclicPolytope(25,198);
381## [ 198, 19503, 1274196, 62117055, 2410141734, 77526225777, 2126433621312,
382##   50768602708824, 1071781612741840, 20256672480820776, 346204947854027808,
383##   5395027104058600008, 48354596155522298656, 262068846498922699590,
384##   940938105142239825104, 2379003007642628680027, 4396097923113038784642,
385##   6062663500381642763609, 6294919173643129209180, 4911378208855785427761,
386##   2840750019404460890298, 1183225500922302444568, 335951678686835900832,
387##   58265626173398052500, 4661250093871844200 ]
388## </Example>
389## </Description>
390## </ManSection>
391## <#/GAPDoc>
392##########################
393InstallGlobalFunction(SCFVectorBdCyclicPolytope,
394function(d,n)
395	local F,i,j,x;
396
397	if(d<=0 or n<d+2) then
398		Info(InfoSimpcomp,1,"SCFVectorBdCyclicPolytope: dimension must be positive, n>d+1.");
399		return fail;
400	fi;
401
402	F:=ListWithIdenticalEntries(d,0);
403
404	for i in [1..Int(d/2)] do
405		F[i]:=Binomial(n,i);
406	od;
407
408	for i in [Int(d/2)+1..d] do
409		F[i]:=0;
410		for j in [0..Int(d/2)] do
411			x:=(Binomial(d-j,i-j)+Binomial(j,i-d+j))*Binomial(n-d-1+j,j);
412			if(d mod 2 = 0 and j=d/2) then
413				F[i]:=F[i]+x/2;
414			else
415				F[i]:=F[i]+x;
416			fi;
417		od;
418	od;
419
420	return F;
421end);
422
423
424################################################################################
425##<#GAPDoc Label="SCFVectorBdSimplex">
426## <ManSection>
427## <Func Name="SCFVectorBdSimplex" Arg="d"/>
428## <Returns> a list of integers of size <C>d + 1</C> upon success, <K>fail</K> otherwise.</Returns>
429## <Description>
430## Computes the <M>f</M>-vector of the <M>d</M>-simplex without generating the underlying complex.
431## <Example>
432## gap> SCFVectorBdSimplex(100);
433## [101, 5050, 166650, 4082925, 79208745, 1267339920, 17199613200,
434##   202095455100, 2088319702700, 19212541264840, 158940114100040,
435##   1192050855750300, 8160963550905900, 51297485177122800, 297525414027312240,
436##   1599199100396803290, 7995995501984016450, 37314645675925410100,
437##   163006083742200475700, 668324943343021950370, 2577824781465941808570,
438##   9373908296239788394800, 32197337191432316660400, 104641345872155029146300,
439##   322295345286237489770604, 942094086221309585483304,
440##   2616928017281415515231400, 6916166902815169575968700,
441##   17409661513983013070541900, 41783187633559231369300560,
442##   95696978128474368620010960, 209337139656037681356273975,
443##   437704928371715151926754675, 875409856743430303853509350,
444##   1675784582908852295948146470, 3072271735332895875904935195,
445##   5397234129638871133346507775, 9090078534128625066688855200,
446##   14683973016669317415420458400, 22760158175837441993901710520,
447##   33862674359172779551902544920, 48375249084532542217003635600,
448##   66375341767149302111702662800, 87494768693060443692698964600,
449##   110826707011209895344085355160, 134919469404951176940625649760,
450##   157884485473879036845412994400, 177620046158113916451089618700,
451##   192119641762857909630770403900, 199804427433372226016001220056,
452##   199804427433372226016001220056, 192119641762857909630770403900,
453##   177620046158113916451089618700, 157884485473879036845412994400,
454##   134919469404951176940625649760, 110826707011209895344085355160,
455##   87494768693060443692698964600, 66375341767149302111702662800,
456##   48375249084532542217003635600, 33862674359172779551902544920,
457##   22760158175837441993901710520, 14683973016669317415420458400,
458##   9090078534128625066688855200, 5397234129638871133346507775,
459##   3072271735332895875904935195, 1675784582908852295948146470,
460##   875409856743430303853509350, 437704928371715151926754675,
461##   209337139656037681356273975, 95696978128474368620010960,
462##   41783187633559231369300560, 17409661513983013070541900,
463##   6916166902815169575968700, 2616928017281415515231400,
464##   942094086221309585483304, 322295345286237489770604,
465##   104641345872155029146300, 32197337191432316660400, 9373908296239788394800,
466##   2577824781465941808570, 668324943343021950370, 163006083742200475700,
467##   37314645675925410100, 7995995501984016450, 1599199100396803290,
468##   297525414027312240, 51297485177122800, 8160963550905900, 1192050855750300,
469##   158940114100040, 19212541264840, 2088319702700, 202095455100, 17199613200,
470##   1267339920, 79208745, 4082925, 166650, 5050, 101]
471## </Example>
472## </Description>
473## </ManSection>
474##<#/GAPDoc>
475################################################################################
476InstallGlobalFunction(SCFVectorBdSimplex,
477function(d)
478	local F;
479	if(d<0) then
480		Info(InfoSimpcomp,1,"SCFVectorBdSimplex: dimension must be positive.");
481		return fail;
482	fi;
483
484	if d=0 then
485		return [0];
486	fi;
487
488	F:=[1..d];
489	Apply(F,x->Binomial(d+1,x));
490	return F;
491end);
492
493
494
495
496
497
498################################################################################
499##<#GAPDoc Label="SCBdCrossPolytope">
500## <ManSection>
501## <Func Name="SCBdCrossPolytope" Arg="d"/>
502## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
503## <Description>
504## Generates the boundary of the <M>d</M>-dimensional cross polytope <M>\beta^{d}</M>, a centrally symmetric combinatorial <M>d-1</M>-sphere.
505## <Example>
506## gap> SCBdCrossPolytope(3); # the octahedron
507## [SimplicialComplex
508##
509##  Properties known: Chi, Dim, F, Facets, HasBoundary, Homology, IsConnected,
510##                    IsStronglyConnected, Name, TopologicalType, VertexLabels.
511##
512##  Name="Bd(\beta^3)"
513##  Dim=2
514##  Chi=2
515##  F=[ 6, 12, 8 ]
516##  Homology=[ [ 0, [ ] ], [ 0, [ ] ], [ 1, [ ] ] ]
517##  IsConnected=true
518##  IsStronglyConnected=true
519##  TopologicalType="S^2"
520##
521## /SimplicialComplex]
522## </Example>
523## </Description>
524## </ManSection>
525##<#/GAPDoc>
526################################################################################
527InstallGlobalFunction(SCBdCrossPolytope,
528function(d)
529
530	local i,j,complex,newComplex,tmp,sc,FVectorCrossPoly,fvec;
531
532	if(d<0) then
533		Info(InfoSimpcomp,1,"SCBdCrossPolytope: dimension must be non-negative.");
534		return fail;
535	fi;
536
537	complex:=[[1],[2]];
538
539	for i in [1..d-1] do
540		newComplex:=[];
541		for j in [1..Size(complex)] do
542			tmp:=[Union(complex[j],[2*i+1]),Union(complex[j],[2*i+2])];
543			Append(newComplex,tmp);
544		od;
545		complex:=newComplex;
546	od;
547
548	sc:=SCFromFacets(complex);
549	if(sc<>fail) then
550		SCRename(sc,Concatenation(["Bd(\\beta^",String(d),")"]));
551		SetSCTopologicalType(sc,Concatenation("S^",String(d-1)));
552		fvec:=SCFVectorBdCrossPolytope(d);
553		tmp:=[];
554		for i in [1..d] do
555			tmp[2*i-1]:=i-1;
556			tmp[2*i]:=fvec[i];
557		od;
558		SetComputedSCNumFacess(sc,tmp);
559		SetSCEulerCharacteristic(sc,1+(-1)^(d-1));
560		SetSCIsConnected(sc,true);
561		SetSCIsStronglyConnected(sc,true);
562		SetSCHasBoundary(sc,false);
563		SetSCHomology(sc,Concatenation(ListWithIdenticalEntries(d-1,[0,[]]),[[1,[]]]));
564	fi;
565	return sc;
566end);
567
568
569################################################################################
570##<#GAPDoc Label="SCBdCyclicPolytope">
571## <ManSection>
572## <Func Name="SCBdCyclicPolytope" Arg="d, n"/>
573## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
574## <Description>
575## Generates the boundary complex of the <Arg>d</Arg>-dimensional cyclic polytope (a combinatorial <M>d-1</M>-sphere) on <Arg>n</Arg> vertices, where <M>n\geq d+2</M>.
576## <Example>
577## gap> SCBdCyclicPolytope(3,8);
578## [SimplicialComplex
579##
580##  Properties known: Chi, Dim, F, Facets, HasBoundary, Homology, IsConnected,
581##                    IsStronglyConnected, Name, TopologicalType, VertexLabels.
582##
583##  Name="Bd(C_3(8))"
584##  Dim=2
585##  Chi=2
586##  F=[ 8, 18, 12 ]
587##  HasBoundary=false
588##  Homology=[ [ 0, [ ] ], [ 0, [ ] ], [ 1, [ ] ] ]
589##  IsConnected=true
590##  IsStronglyConnected=true
591##  TopologicalType="S^2"
592##
593## /SimplicialComplex]
594## </Example>
595## </Description>
596## </ManSection>
597##<#/GAPDoc>
598################################################################################
599InstallGlobalFunction(SCBdCyclicPolytope,
600function(d,n)
601
602	local s,i,a,b,facets,sc,fvec,tmp;
603
604	if(d<0 or n<d+2) then
605		Info(InfoSimpcomp,1,"SCBdCyclicPolytope: dimension must be non-negative, n>=d+2.");
606		return fail;
607	fi;
608
609	#construct facets using gale's evenness condition
610	facets:=[];
611	if IsInt(d/2) = true then
612		for s in Combinations([1..(n-d/2)],d/2) do
613			a:=[];
614			for i in s do
615				Add(a,i+Position(s,i)-1);
616				Add(a,i+Position(s,i));
617		od;
618		Add(facets,a);
619	od;
620
621	for s in Combinations([1..(n-2-(d-2)/2)],(d-2)/2) do
622		a:=[];
623		for i in s do
624			Add(a,i+Position(s,i));
625			Add(a,i+Position(s,i)+1);
626		od;
627			Add(a,1);
628			Add(a,n);
629			Add(facets,a);
630		od;
631	else
632		for s in Combinations([1..(n-1-(d-1)/2)],(d-1)/2) do
633			a:=[];
634			b:=[];
635			for i in s do
636				Add(a,i+Position(s,i));
637				Add(a,i+Position(s,i)+1);
638				Add(b,i+Position(s,i)-1);
639				Add(b,i+Position(s,i));
640			od;
641			Add(a,1);
642			Add(b,n);
643			Add(facets,a);
644			Add(facets,b);
645		od;
646	fi;
647
648	sc:=SCFromFacets(facets);
649	if(sc<>fail) then
650		SCRename(sc,Concatenation(["Bd(C_",String(d),"(",String(n),"))"]));
651		SetSCTopologicalType(sc,Concatenation("S^",String(d-1)));
652		fvec:=SCFVectorBdCyclicPolytope(d,n);
653		tmp:=[];
654		for i in [1..d] do
655			tmp[2*i-1]:=i-1;
656			tmp[2*i]:=fvec[i];
657		od;
658		SetComputedSCNumFacess(sc,tmp);
659		SetSCEulerCharacteristic(sc,1+(-1)^(d-1));
660		SetSCIsConnected(sc,true);
661		SetSCIsStronglyConnected(sc,true);
662		SetSCHasBoundary(sc,false);
663		SetSCHomology(sc,Concatenation(ListWithIdenticalEntries(d-1,[0,[]]),[[1,[]]]));
664	fi;
665	return sc;
666end);
667
668
669
670################################################################################
671##<#GAPDoc Label="SCBdSimplex">
672## <ManSection>
673## <Func Name="SCBdSimplex" Arg="d"/>
674## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
675## <Description>
676## Generates the boundary of the <M>d</M>-simplex <M>\Delta^d</M>, a combinatorial <M>d-1</M>-sphere.
677## <Example>
678## gap> SCBdSimplex(5);
679## [SimplicialComplex
680##
681##  Properties known: AutomorphismGroup, AutomorphismGroupOrder,
682##                    AutomorphismGroupStructure, AutomorphismGroupTransitivity,
683##                    Chi, Dim, F, Facets, Generators, HasBoundary, Homology,
684##                    IsConnected, IsStronglyConnected, Name, TopologicalType,
685##                    VertexLabels.
686##
687##  Name="S^4_6"
688##  Dim=4
689##  AutomorphismGroupStructure="S6"
690##  AutomorphismGroupTransitivity=6
691##  Chi=2
692##  F=[ 6, 15, 20, 15, 6 ]
693##  Homology=[ [ 0, [ ] ], [ 0, [ ] ], [ 0, [ ] ], [ 0, [ ] ], [ 1, [ ] ] ]
694##  IsConnected=true
695##  IsStronglyConnected=true
696##  TopologicalType="S^4"
697##
698## /SimplicialComplex]
699## </Example>
700## </Description>
701## </ManSection>
702##<#/GAPDoc>
703################################################################################
704InstallGlobalFunction(SCBdSimplex,
705function(d)
706
707	local complex,sc,fvec,tmp,G,i;
708
709	if(d<0) then
710		Info(InfoSimpcomp,1,"SCBdSimplex: dimension must be non-negative.");
711		return fail;
712	fi;
713
714	complex:=Combinations([1..d+1],d);
715	sc:=SCFromFacets(complex);
716
717	if(sc<>fail) then
718		SCRename(sc,Concatenation(["S^",String(d-1),"_",String(d+1)]));
719		SetSCTopologicalType(sc,Concatenation("S^",String(d-1)));
720		fvec:=SCFVectorBdSimplex(d);
721		tmp:=[];
722		for i in [1..d] do
723			tmp[2*i-1]:=i-1;
724			tmp[2*i]:=fvec[i];
725		od;
726		SetComputedSCNumFacess(sc,tmp);
727		SetSCEulerCharacteristic(sc,1+(-1)^(d-1));
728		G:=SymmetricGroup(IsPermGroup,d+1);
729		SetSCAutomorphismGroup(sc,G);
730		SetSCAutomorphismGroupTransitivity(sc,d+1);
731		SetSCAutomorphismGroupSize(sc,Factorial(d+1));
732		SetSCAutomorphismGroupStructure(sc,Concatenation("S",String(d+1)));
733		SetSCGeneratorsEx(sc,[[[1..d],[d+1]]]);
734		if d>1 then
735			SetSCIsConnected(sc,true);
736			SetSCIsStronglyConnected(sc,true);
737		elif d=1 then
738			SetSCIsConnected(sc,false);
739			SetSCIsStronglyConnected(sc,false);
740		fi;
741		SetSCHasBoundary(sc,false);
742		SetSCHomology(sc,Concatenation(ListWithIdenticalEntries(d-1,[0,[]]),[[1,[]]]));
743	fi;
744	return sc;
745end);
746
747
748################################################################################
749##<#GAPDoc Label="SCSimplex">
750## <ManSection>
751## <Func Name="SCSimplex" Arg="d"/>
752## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
753## <Description>
754## Generates the <Arg>d</Arg>-simplex.
755## <Example>
756## gap> SCSimplex(3);
757## [SimplicialComplex
758##
759##  Properties known: Chi, Dim, Facets, Name, TopologicalType, VertexLabels.
760##
761##  Name="B^3_4"
762##  Dim=3
763##  Chi=1
764##  TopologicalType="B^3"
765##
766## /SimplicialComplex]
767## </Example>
768## </Description>
769## </ManSection>
770##<#/GAPDoc>
771################################################################################
772InstallGlobalFunction(SCSimplex,
773function(d)
774	local facets,i,sc,tmp,fvec;
775
776	facets:=[[1..d+1]];
777	sc:=SCFromFacets(facets);
778
779	if(sc<>fail) then
780		fvec:=SCFVectorBdSimplex(d);
781		tmp:=[];
782		for i in [1..d] do
783			tmp[2*i-1]:=i-1;
784			tmp[2*i]:=fvec[i];
785		od;
786		tmp[2*d+1]:=d;
787		tmp[2*(d+1)]:=1;
788		SetComputedSCNumFacess(sc,tmp);
789		SCRename(sc,Concatenation(["B^",String(d),"_",String(d+1)]));
790		SetSCTopologicalType(sc,Concatenation("B^",String(d)));
791		SetSCEulerCharacteristic(sc,1);
792	fi;
793
794	return sc;
795end);
796
797
798################################################################################
799##<#GAPDoc Label="SCCartesianProduct">
800## <ManSection>
801## <Meth Name="SCCartesianProduct" Arg="complex1,complex2"/>
802## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
803## <Description>
804## Computes the simplicial cartesian product of <Arg>complex1</Arg> and <Arg>complex2</Arg> where  <Arg>complex1</Arg> and <Arg>complex2</Arg> are pure, simplicial complexes. The original vertex labeling of <Arg>complex1</Arg> and <Arg>complex2</Arg> is changed into the standard one. The new complex has vertex labels of type <M>[v_i, v_j]</M> where <M>v_i</M> is a vertex of <Arg>complex1</Arg> and <M>v_j</M> is a vertex of <Arg>complex2</Arg>.<P/>
805## If <M>n_i</M>, <M>i=1,2</M>, are the number facets and <M>d_i</M>, <M>i=1,2</M>, are the dimensions of <Arg>complexi</Arg>, then the new complex has <M>n_1 \cdot n_2 \cdot { d_1+d_2 \choose d_1}</M> facets. The number of vertices of the new complex equals the product of the numbers of vertices of the arguments.
806## <Example>
807## gap> c1:=SCBdSimplex(2);;
808## gap> c2:=SCBdSimplex(3);;
809## gap> c3:=SCCartesianProduct(c1,c2);
810## [SimplicialComplex
811##
812##  Properties known: Dim, Facets, Name, TopologicalType, VertexLabels.
813##
814##  Name="S^1_3xS^2_4"
815##  Dim=3
816##  TopologicalType="S^1xS^2"
817##
818## /SimplicialComplex]
819## gap> c3.Homology;
820## [ [ 0, [  ] ], [ 1, [  ] ], [ 1, [  ] ], [ 1, [  ] ] ]
821## gap> c3.F;
822## [ 12, 48, 72, 36 ]
823## </Example>
824## </Description>
825## </ManSection>
826##<#/GAPDoc>
827################################################################################
828InstallMethod(SCCartesianProduct,
829"for SCSimplicialComplex and SCSimplicialComplex",
830[SCIsSimplicialComplex,SCIsSimplicialComplex],
831function(complex1, complex2)
832
833	local dim1, dim2,facets1,facets2,facets,nFacets,
834			i, j, flag, tmp, idx, element, facet, ctr,
835			combinations, paths,names,scprod,toptypes,vertices;
836
837	if SCIsEmpty(complex1) or SCIsEmpty(complex2) then
838		return SCEmpty();
839	fi;
840
841	#save names
842	if HasSCName(complex1) and HasSCName(complex2) then
843		names:=[SCName(complex1),SCName(complex2)];
844	fi;
845	if HasSCTopologicalType(complex1) and HasSCTopologicalType(complex2) then
846		toptypes:=[SCTopologicalType(complex1),SCTopologicalType(complex2)];
847	fi;
848	vertices:=[];
849
850	# extract facets
851	facets1:=SCFacetsEx(complex1);
852	facets2:=SCFacetsEx(complex2);
853	if facets1=fail or facets2=fail then
854		return fail;
855	fi;
856
857	# compute complex dimensions
858	tmp :=SCIsPure(complex1);
859	dim1:= SCDim(complex1);
860	if dim1=fail or tmp=fail or tmp=false then
861		if(tmp=false) then
862			Info(InfoSimpcomp,1,"SCCartesianProduct: complex1 not pure");
863			return fail;
864		else
865			return fail;
866		fi;
867	fi;
868
869	tmp :=SCIsPure(complex2);
870	dim2:= SCDim(complex2);
871	if dim1=fail or tmp=fail or tmp=false then
872		if(tmp=false) then
873			Info(InfoSimpcomp,1,"SCCartesianProduct: complex2 not pure");
874			return fail;
875		else
876			return fail;
877		fi;
878	fi;
879
880	# compute possible combinations
881	combinations:=Cartesian(facets1,facets2);
882	# compute paths
883	tmp:=Concatenation(ListWithIdenticalEntries(dim1,1),ListWithIdenticalEntries(dim2,2));
884	paths:=Arrangements(tmp,Size(tmp));
885	# compute facets of Cartesian product
886	facets:=[];
887	nFacets:= Size(facets1)*Size(facets2)*Binomial(dim1+dim2,dim1);
888	ctr:=0;
889	for element in combinations do
890		for i in paths do
891			idx:=[1,1];
892			facet:=[];
893			facet[1]:=[element[1][1],element[2][1]];
894			for j in [1..dim1+dim2] do
895				idx[i[j]]:=idx[i[j]]+1;
896				facet[j+1]:=[element[1][idx[1]],element[2][idx[2]]];
897			od;
898			if Size(facet)=dim1 + dim2 + 1 then
899				Add(facets,facet);
900			else
901				Info(InfoSimpcomp,1,"SCCartesianProduct: facet ",facet," has wrong dimension.");
902			fi;
903			ctr:=ctr+1;
904		od;
905	od;
906
907
908	vertices:=Union(facets);
909	for i in [1..Size(facets)] do
910		for j in [1..Size(facets[i])] do
911			facets[i][j] := Position(vertices,facets[i][j]);
912		od;
913	od;
914	scprod:=SCFromFacets(facets);
915
916	if(IsBound(toptypes)) then
917		SetSCTopologicalType(scprod,Concatenation([toptypes[1],"x",toptypes[2]]));
918	fi;
919
920	if(IsBound(names)) then
921		SCRename(scprod,Concatenation([names[1],"x",names[2]]));
922	fi;
923
924	return scprod;
925
926end);
927
928
929################################################################################
930##<#GAPDoc Label="SCCartesianPower">
931## <ManSection>
932## <Meth Name="SCCartesianPower" Arg="complex,n"/>
933## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
934## <Description>
935## The new complex is <M>PL</M>-homeomorphic to <M>n</M> times the cartesian product of <Arg>complex</Arg>, of dimensions <M>n \cdot d</M> and has <M>f_{d}^n \cdot n \cdot \frac{2n-1}{2^{n-1}}!</M> facets where <M>d</M> denotes the dimension and <M>f_d</M> denotes the number of facets of <Arg>complex</Arg>. Note that the complex returned by the function is not the <M>n</M>-fold cartesian product <Arg>complex</Arg><M>^n</M> of <Arg>complex</Arg> (which, in general, is not simplicial) but a simplicial subdivision of <Arg>complex</Arg><M>^n</M>.
936## <Example>
937## gap> c:=SCBdSimplex(2);;
938## gap> 4torus:=SCCartesianPower(c,4);
939## [SimplicialComplex
940##
941##  Properties known: Dim, Facets, Name, TopologicalType, VertexLabels.
942##
943##  Name="(S^1_3)^4"
944##  Dim=4
945##  TopologicalType="(S^1)^4"
946##
947## /SimplicialComplex]
948## gap> 4torus.Homology;
949## [ [ 0, [  ] ], [ 4, [  ] ], [ 6, [  ] ], [ 4, [  ] ], [ 1, [  ] ] ]
950## gap> 4torus.Chi;
951## 0
952## gap> 4torus.F;
953## [ 81, 1215, 4050, 4860, 1944 ]
954## </Example>
955## </Description>
956## </ManSection>
957##<#/GAPDoc>
958################################################################################
959InstallMethod(SCCartesianPower,
960"for SCSimplicialComplex and Int",
961[SCIsSimplicialComplex,IsInt],
962function(complex, n)
963
964	local dim1, facets1,facets,nFacets,
965		i, j, k, flag, tmp, idx, element, facet, ctr,
966		combinations, paths, vertices, sc, name, toptype;
967
968	if SCIsEmpty(complex) then
969		return SCEmpty();
970	fi;
971
972	if HasSCName(complex) then
973		name:=SCName(complex);
974	fi;
975	if HasSCTopologicalType(complex) then
976		toptype:=SCTopologicalType(complex);
977	fi;
978
979	# extract facets
980	facets1:=SCFacetsEx(complex);
981	if facets1=fail then
982		return fail;
983	fi;
984
985	# compute possible combinations
986	tmp:=ListWithIdenticalEntries(n,facets1);
987	combinations:=Cartesian(tmp);
988
989	# compute complex dimensions
990	tmp :=SCIsPure(complex);
991	dim1:= SCDim(complex);
992	if dim1=fail or tmp=fail or tmp=false then
993		if(tmp=false) then
994			Info(InfoSimpcomp,1,"SCCartesianPower: complex not pure");
995		fi;
996		return fail;
997	fi;
998
999
1000	# compute paths
1001	tmp:=[];
1002	for i in [1..n] do
1003		for j in [1..dim1] do
1004			Add(tmp,i);
1005		od;
1006	od;
1007
1008	paths:=Arrangements(tmp,Size(tmp));
1009
1010	# compute facets of Cartesian product
1011	facets:=[];
1012	nFacets:= (Size(facets1)^n)*n*(Factorial(2*n-1)/2^(n-1));
1013	ctr:=0;
1014	for element in combinations do
1015		for i in paths do
1016			idx:=ListWithIdenticalEntries(n,1);
1017			facet:=[];
1018			facet[1]:=[];
1019			for j in [1..n] do
1020				facet[1][j]:=element[j][1];
1021			od;
1022			for j in [1..n*dim1] do
1023				facet[j+1]:=[];
1024				idx[i[j]]:=idx[i[j]]+1;
1025				for k in [1..n] do
1026					facet[j+1][k]:=element[k][idx[k]];
1027				od;
1028			od;
1029			if Size(facet)=n*dim1 + 1 then
1030				Add(facets,facet);
1031			else
1032				Info(InfoSimpcomp,1,"SCCartesianPower: facet ",facet," has wrong dimension.");
1033			fi;
1034			ctr:=ctr+1;
1035		od;
1036	od;
1037
1038	vertices:=Union(facets);
1039	for i in [1..Size(facets)] do
1040		for j in [1..Size(facets[i])] do
1041			facets[i][j] := Position(vertices,facets[i][j]);
1042		od;
1043	od;
1044	sc:=SCFromFacets(facets);
1045
1046	if(IsBound(toptype)) then
1047		SetSCTopologicalType(sc,Concatenation(["(",toptype,")^",String(n)]));
1048	fi;
1049
1050	if(IsBound(name)) then
1051		SCRename(sc,Concatenation(["(",name,")^",String(n)]));
1052	fi;
1053
1054	return sc;
1055
1056end);
1057
1058
1059
1060################################################################################
1061##<#GAPDoc Label="SCConnectedSumMinus">
1062## <ManSection>
1063## <Meth Name="SCConnectedSumMinus" Arg="complex1,complex2"/>
1064## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
1065## <Description>
1066## In a lexicographic ordering the smallest facet of both <Arg>complex1</Arg> and  <Arg>complex2</Arg> is removed and the complexes are glued together along the resulting boundaries. The bijection used to identify the vertices of the boundaries differs from the one chosen in <Ref Func="SCConnectedSum"/> by a transposition. Thus, the topological type of <C>SCConnectedSumMinus</C> is different from the one of <Ref Func="SCConnectedSum"/> whenever <Arg>complex1</Arg> and <Arg>complex2</Arg> do not allow an orientation reversing homeomorphism.
1067## <Example>
1068## gap> SCLib.SearchByName("T^2"){[1..6]};
1069## [ [ 5, "T^2 (VT)" ], [ 7, "T^2 (VT)" ], [ 11, "T^2 (VT)" ],
1070##   [ 12, "T^2 (VT)" ], [ 20, "T^2 (VT)" ], [ 22, "(T^2)#2" ],
1071##   [ 27, "(T^2)#3" ], [ 41, "T^2 (VT)" ], [ 44, "(T^2)#4" ], ...
1072## gap> torus:=SCLib.Load(last[1][1]);;
1073## gap> genus2:=SCConnectedSumMinus(torus,torus);
1074## [SimplicialComplex
1075##
1076##  Properties known: Dim, Facets, Name, VertexLabels.
1077##
1078##  Name="T^2 (VT)#+-T^2 (VT)"
1079##  Dim=2
1080##
1081## /SimplicialComplex]
1082## gap> genus2.Homology;
1083## [ [ 0, [  ] ], [ 4, [  ] ], [ 1, [  ] ] ]
1084## gap> genus2.Chi;
1085## -2
1086## </Example>
1087## <Example>
1088## gap> SCLib.SearchByName("CP^2");
1089## [ [ 17, "CP^2 (VT)" ], [ 88, "CP^2#CP^2" ], [ 89, "CP^2#-CP^2" ],
1090##   [ 186, "CP^2#(S^2xS^2)" ], [ 499, "(S^3~S^1)#(CP^2)^{#5} (VT)" ] ]
1091## gap> cp2:=SCLib.Load(last[1][1]);;
1092## # CP^2 # CP^2 (signature of intersection form is 2)
1093## gap> c1:=SCConnectedSum(cp2,cp2);;
1094## # CP^2 # - CP^2 (signature of intersection form is 0)
1095## gap> c2:=SCConnectedSumMinus(cp2,cp2);;
1096## gap> c1.F=c2.F;
1097## true
1098## gap> c1.ASDet=c2.ASDet;
1099## true
1100## gap> SCIsIsomorphic(c1,c2);
1101## false
1102## gap> PrintArray(SCIntersectionForm(c1));
1103## [ [  1,  0 ],
1104##   [  0,  1 ] ]
1105## gap> PrintArray(SCIntersectionForm(c2));
1106## [ [   1,   0 ],
1107##   [   0,  -1 ] ]
1108## </Example>
1109## </Description>
1110## </ManSection>
1111##<#/GAPDoc>
1112################################################################################
1113InstallMethod(SCConnectedSumMinus,
1114"for SCSimplicialComplex and SCSimplicialComplex",
1115[SCIsSimplicialComplex,SCIsSimplicialComplex],
1116function(complex1, complex2)
1117
1118	local maxvertex1, maxvertex2, facets1, facets2, simplex1, simplex2,
1119		maptable, i, j, sc, name1, name2, vertices, idx, dim1, dim2, pure1, pure2;
1120
1121	pure1:=SCIsPure(complex1);
1122	pure2:=SCIsPure(complex2);
1123	if pure1 <> true or pure2 <> true then
1124		Info(InfoSimpcomp,1,"SCConnectedSumMinus: complexes must be pure simplicial copmplexes.");
1125		return fail;
1126	fi;
1127
1128	dim1:=SCDim(complex1);
1129	dim2:=SCDim(complex2);
1130	if dim1 = fail or dim2 = fail then
1131		Info(InfoSimpcomp,1,"SCConnectedSumMinus: complexes must have the same dimension");
1132		return fail;
1133	fi;
1134
1135	if dim1 < 1 or dim2 < 1 then
1136		Info(InfoSimpcomp,1,"SCConnectedSumMinus: complexes must have at least dimension 1.");
1137		return fail;
1138	fi;
1139
1140	if dim1 <> dim2 then
1141		Info(InfoSimpcomp,1,"SCConnectedSumMinus: complexes are not of the same dimension.");
1142		return fail;
1143	fi;
1144
1145	if HasSCName(complex1) and HasSCName(complex2) then
1146		name1:=SCName(complex1);
1147		name2:=SCName(complex2);
1148	fi;
1149
1150	# compute maximal labels
1151	maxvertex1:=Maximum(SCVerticesEx(complex1));
1152	maxvertex2:=Maximum(SCVerticesEx(complex2));
1153	if maxvertex1=fail or maxvertex2=fail then
1154		Info(InfoSimpcomp,1,"SCConnectedSumMinus: complex lacks vertex labels.");
1155		return fail;
1156	fi;
1157
1158	# facets in standard labeling
1159	facets1:=SCIntFunc.DeepCopy(SCFacetsEx(complex1));
1160	facets2:=SCIntFunc.DeepCopy(SCFacetsEx(complex2)+maxvertex1);
1161
1162	if facets1=fail or facets2=fail then
1163		Info(InfoSimpcomp,1,"SCConnectedSumMinus: complex lacks facets.");
1164		return fail;
1165	fi;
1166
1167	# relabel facets2
1168	simplex1:=SCIntFunc.DeepCopy(facets1[1]);
1169	simplex2:=SCIntFunc.DeepCopy(facets2[1]);
1170	RemoveSet(facets1,simplex1);
1171	RemoveSet(facets2,simplex2);
1172	for i in [1..Size(facets2)] do
1173		for j in [1..Size(facets2[i])] do
1174			if facets2[i][j] in simplex2 then
1175				idx := Position(simplex2,facets2[i][j]);
1176				facets2[i][j]:=simplex1[idx];
1177			fi;
1178		od;
1179	od;
1180	for i in [1..Size(facets2)] do
1181		Sort(facets2[i]);
1182	od;
1183	Sort(facets2);
1184
1185	if not IsSet(facets1) then
1186		facets1:=Set(facets1);
1187	fi;
1188	if not IsSet(facets2) then
1189		facets2:=Set(facets2);
1190	fi;
1191
1192	sc:=SCFromFacets(Union(facets1,facets2));
1193	vertices:=SCVerticesEx(sc);
1194
1195	if(vertices=fail) then
1196		return fail;
1197	fi;
1198	SCRelabelStandard(sc);
1199
1200	if(IsBound(name1) and IsBound(name2)) then
1201		SCRename(sc,Concatenation(name1,"#+-",name2));
1202	fi;
1203
1204	return sc;
1205
1206end);
1207
1208
1209SCIntFunc.ConnectedSumEx:=function(facets1,facets2)
1210	local simplex1,simplex2,i,j, idx;
1211
1212	# relabel facets2
1213	simplex1:=SCIntFunc.DeepCopy(facets1[1]);
1214	simplex2:=SCIntFunc.DeepCopy(facets2[1]);
1215	Remove(facets1,Position(facets1,simplex1));
1216	Remove(facets2,Position(facets2,simplex2));
1217	for i in [1..Size(facets2)] do
1218		for j in [1..Size(facets2[i])] do
1219			if facets2[i][j] in simplex2 then
1220				idx := Position(simplex2,facets2[i][j]);
1221				if idx = 1 then
1222					facets2[i][j]:=simplex1[2];
1223				elif idx = 2 then
1224					facets2[i][j]:=simplex1[1];
1225				else
1226					facets2[i][j]:=simplex1[idx];
1227				fi;
1228			fi;
1229		od;
1230	od;
1231
1232	return [facets1,facets2];
1233end;
1234
1235################################################################################
1236##<#GAPDoc Label="SCConnectedSum">
1237## <ManSection>
1238## <Meth Name="SCConnectedSum" Arg="complex1,complex2"/>
1239## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
1240## <Description>
1241## In a lexicographic ordering the smallest facet of both <Arg>complex1</Arg> and <Arg>complex2</Arg> is removed and the complexes are glued together along the resulting boundaries. The bijection used to identify the vertices of the boundaries differs from the one chosen in <Ref Func="SCConnectedSumMinus"/> by a transposition. Thus, the topological type of <C>SCConnectedSum</C> is different from the one of <Ref Func="SCConnectedSumMinus"/> whenever <Arg>complex1</Arg> and <Arg>complex2</Arg> do not allow an orientation reversing homeomorphism.
1242## <Example>
1243## gap> SCLib.SearchByName("T^2"){[1..6]};
1244## [ [ 5, "T^2 (VT)" ], [ 7, "T^2 (VT)" ], [ 11, "T^2 (VT)" ],
1245##   [ 12, "T^2 (VT)" ], [ 20, "T^2 (VT)" ], [ 22, "(T^2)#2" ],
1246##   [ 27, "(T^2)#3" ], [ 41, "T^2 (VT)" ], [ 44, "(T^2)#4" ], ...
1247## gap> torus:=SCLib.Load(last[1][1]);;
1248## gap> genus2:=SCConnectedSum(torus,torus);
1249## [SimplicialComplex
1250##
1251##  Properties known: Dim, Facets, Name, VertexLabels.
1252##
1253##  Name="T^2 (VT)#+-T^2 (VT)"
1254##  Dim=2
1255##
1256## /SimplicialComplex]
1257## gap> genus2.Homology;
1258## [ [ 0, [  ] ], [ 4, [  ] ], [ 1, [  ] ] ]
1259## gap> genus2.Chi;
1260## -2
1261## </Example>
1262## <Example>
1263## gap> SCLib.SearchByName("CP^2");
1264## [ [ 17, "CP^2 (VT)" ], [ 88, "CP^2#CP^2" ], [ 89, "CP^2#-CP^2" ],
1265##   [ 186, "CP^2#(S^2xS^2)" ], [ 499, "(S^3~S^1)#(CP^2)^{#5} (VT)" ] ]
1266## gap> cp2:=SCLib.Load(last[1][1]);;
1267## # CP^2 # CP^2 (signature of intersection form is 2)
1268## gap> c1:=SCConnectedSum(cp2,cp2);;
1269## # CP^2 # - CP^2 (signature of intersection form is 0)
1270## gap> c2:=SCConnectedSumMinus(cp2,cp2);;
1271## gap> c1.F=c2.F;
1272## true
1273## gap> c1.ASDet=c2.ASDet;
1274## true
1275## gap> SCIsIsomorphic(c1,c2);
1276## false
1277## gap> PrintArray(SCIntersectionForm(c1));
1278## [ [  1,  0 ],
1279##   [  0,  1 ] ]
1280## gap> PrintArray(SCIntersectionForm(c2));
1281## [ [   1,   0 ],
1282##   [   0,  -1 ] ]
1283## </Example>
1284## </Description>
1285## </ManSection>
1286##<#/GAPDoc>
1287################################################################################
1288InstallMethod(SCConnectedSum,
1289"for SCSimplicialComplex and SCSimplicialComplex",
1290[SCIsSimplicialComplex,SCIsSimplicialComplex],
1291function(complex1, complex2)
1292
1293	local maxvertex1, maxvertex2, facets,facets1, facets2, simplex1, simplex2,
1294		maptable, i, j, sc, name1, name2, vertices, idx, dim1, dim2, pure1, pure2;
1295
1296	if(not SCIsSimplicialComplex(complex1) or not SCIsSimplicialComplex(complex2)) then
1297		Info(InfoSimpcomp,1,"SCConnectedSum: arguments must be of type SCSimplicialComplex.");
1298		return fail;
1299	fi;
1300
1301	pure1:=SCIsPure(complex1);
1302	pure2:=SCIsPure(complex2);
1303	if pure1 <> true or pure2 <> true then
1304		Info(InfoSimpcomp,1,"SCConnectedSum: complexes must be pure simplicial copmplexes.");
1305		return fail;
1306	fi;
1307
1308	dim1:=SCDim(complex1);
1309	dim2:=SCDim(complex2);
1310	if dim1 = fail or dim2 = fail then
1311		Info(InfoSimpcomp,1,"SCConnectedSum: complexes must have the same dimension");
1312		return fail;
1313	fi;
1314
1315	if dim1 < 1 or dim2 < 1 then
1316		Info(InfoSimpcomp,1,"SCConnectedSum: complexes must have at least dimension 1.");
1317		return fail;
1318	fi;
1319
1320	if dim1 <> dim2 then
1321		Info(InfoSimpcomp,1,"SCConnectedSum: complexes are not of the same dimension.");
1322		return fail;
1323	fi;
1324
1325	if HasSCName(complex1) and HasSCName(complex2) then
1326		name1:=SCName(complex1);
1327		name2:=SCName(complex2);
1328	fi;
1329
1330	# compute maximal labels
1331	maxvertex1:=Maximum(SCVerticesEx(complex1));
1332	maxvertex2:=Maximum(SCVerticesEx(complex2));
1333	if maxvertex1=fail or maxvertex2=fail then
1334		Info(InfoSimpcomp,1,"SCConnectedSum: complex lacks vertex labels.");
1335		return fail;
1336	fi;
1337
1338	# facets in standard labeling
1339	facets1:=SCIntFunc.DeepCopy(SCFacetsEx(complex1));
1340	facets2:=SCIntFunc.DeepCopy(SCFacetsEx(complex2)+maxvertex1);
1341
1342	if facets1=fail or facets2=fail or name1 = fail or name2 = fail then
1343		Info(InfoSimpcomp,1,"SCConnectedSum: complex lacks name or facets.");
1344		return fail;
1345	fi;
1346
1347	facets:=SCIntFunc.ConnectedSumEx(facets1,facets2);
1348	facets1:=facets[1];
1349	facets2:=facets[2];
1350
1351	for i in [1..Size(facets2)] do
1352		Sort(facets2[i]);
1353	od;
1354	Sort(facets2);
1355
1356	if not IsSet(facets1) then
1357		facets1:=Set(facets1);
1358	fi;
1359	if not IsSet(facets2) then
1360		facets2:=Set(facets2);
1361	fi;
1362
1363	sc:=SCFromFacets(Union(facets1,facets2));
1364
1365	if(IsBound(name1) and IsBound(name2)) then
1366		SCRename(sc,Concatenation(name1,"#+-",name2));
1367	fi;
1368
1369	return sc;
1370
1371end);
1372
1373################################################################################
1374##<#GAPDoc Label="SCConnectedProduct">
1375## <ManSection>
1376## <Meth Name="SCConnectedProduct" Arg="complex,n"/>
1377## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
1378## <Description>
1379## If <M>n \geq 2</M>, the function internally calls <M>1 \times</M> <Ref Func="SCConnectedSum"/> and <M>(n-2) \times</M> <Ref Func="SCConnectedSumMinus"/>.
1380## <Example>
1381## gap> SCLib.SearchByName("T^2"){[1..6]};
1382## [ [ 5, "T^2 (VT)" ], [ 7, "T^2 (VT)" ], [ 11, "T^2 (VT)" ],
1383##   [ 12, "T^2 (VT)" ], [ 20, "T^2 (VT)" ], [ 22, "(T^2)#2" ],
1384##   [ 27, "(T^2)#3" ], [ 41, "T^2 (VT)" ], [ 44, "(T^2)#4" ], ...
1385## gap> torus:=SCLib.Load(last[1][1]);;
1386## gap> genus10:=SCConnectedProduct(torus,10);
1387## [SimplicialComplex
1388##
1389##  Properties known: Dim, Facets, Name, VertexLabels.
1390##
1391##  Name="T^2 (VT)#+-T^2 (VT)#+-T^2 (VT)#+-T^2 (VT)#+-T^2 (VT)#+-T^2 (VT)#+-T^2 (\
1392## VT)#+-T^2 (VT)#+-T^2 (VT)#+-T^2 (VT)"
1393##  Dim=2
1394##
1395## /SimplicialComplex]
1396## gap> genus10.Chi;
1397## -18
1398## gap> genus10.F;
1399## [ 43, 183, 122 ]
1400## </Example>
1401## </Description>
1402## </ManSection>
1403##<#/GAPDoc>
1404################################################################################
1405InstallMethod(SCConnectedProduct,
1406"for SCSimplicialComplex and Int",
1407[SCIsSimplicialComplex,IsInt],
1408function(complex, n)
1409
1410	local maxvertex, newComplex, maptable, i, idx, tmp, sc, dim, facets, facets1, facets2, name, pure;
1411
1412	if(not SCIsSimplicialComplex(complex)) then
1413		Info(InfoSimpcomp,1,"SCConnectedProduct: argument must be of type SCSimplicialComplex.");
1414		return fail;
1415	fi;
1416
1417	pure:=SCIsPure(complex);
1418	if pure <> true then
1419		Info(InfoSimpcomp,1,"SCConnectedProduct: complex must be a pure simplicial complex.");
1420		return fail;
1421	fi;
1422
1423	dim := SCDim(complex);
1424	if dim = fail then
1425		return fail;
1426	fi;
1427
1428	if dim < 1 then
1429		Info(InfoSimpcomp,1,"SCConnectedProduct: complex must be at least of dimensions 1.");
1430		return fail;
1431	fi;
1432
1433	if SCIsEmpty(complex) then
1434		Info(InfoSimpcomp,1,"SCConnectedProduct: complexes is empty.");
1435		return SCEmpty();
1436	fi;
1437	if n<1 then
1438		return SCEmpty();
1439	elif n=1 then
1440		return complex;
1441	else
1442		name:=SCName(complex);
1443
1444		maxvertex:=Maximum(SCVerticesEx(complex));
1445		if maxvertex=fail then
1446			Info(InfoSimpcomp,1,"SCConnectedProduct: complex lacks vertex labels.");
1447			return fail;
1448		fi;
1449
1450		# facets in standard labeling
1451		facets1:=SCIntFunc.DeepCopy(SCFacetsEx(complex));
1452		if facets1=fail then
1453			return fail;
1454		fi;
1455
1456		for i in [1..(n-1)] do
1457			facets2:=SCIntFunc.DeepCopy(SCFacetsEx(complex)+i*maxvertex);
1458			facets1:=Concatenation(SCIntFunc.ConnectedSumEx(facets1,facets2));
1459		od;
1460
1461		for i in [1..Size(facets1)] do
1462			Sort(facets1[i]);
1463		od;
1464		Sort(facets1);
1465
1466		if not IsSet(facets1) then
1467			facets1:=Set(facets1);
1468		fi;
1469
1470		sc:=SCFromFacets(facets1);
1471
1472		if(name<>fail) then
1473			SCRename(sc,Concatenation(Concatenation(ListWithIdenticalEntries(n-1,Concatenation(name,"#+-"))),name));
1474		fi;
1475
1476		return sc;
1477	fi;
1478
1479end);
1480
1481################################################################################
1482##<#GAPDoc Label="SCDifferenceCycleExpand">
1483## <ManSection>
1484## <Func Name="SCDifferenceCycleExpand" Arg="diffcycle"/>
1485## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
1486## <Description>
1487## <Arg>diffcycle</Arg> induces a simplex <M>\Delta = ( v_1 , \ldots , v_{n+1} )</M> by <M>v_1 = </M><Arg>diffcycle[1]</Arg>, <M>v_i = v_{i-1} + </M> <Arg>diffcycle[i]</Arg> and a cyclic group action by <M>\mathbb{Z}_{\sigma}</M> where <M>\sigma = \sum </M> <Arg>diffcycle[i]</Arg> is the modulus of <C>diffcycle</C>. The function returns the <M>\mathbb{Z}_{\sigma}</M>-orbit of <M>\Delta</M>.<P/>
1488## Note that modulo operations in &GAP; are often a little bit cumbersome, since all integer ranges usually start from <M>1</M>.
1489## <Example>
1490## gap> c:=SCDifferenceCycleExpand([1,1,2]);;
1491## gap> c.Facets;
1492## [ [ 1, 2, 3 ], [ 1, 2, 4 ], [ 1, 3, 4 ], [ 2, 3, 4 ] ]
1493## </Example>
1494## </Description>
1495## </ManSection>
1496##<#/GAPDoc>
1497################################################################################
1498InstallGlobalFunction(SCDifferenceCycleExpand,
1499	function(diffcycle)
1500	local rs,i,modulus,orbit;
1501
1502	if(Length(diffcycle)<1 or not ForAll(diffcycle,IsPosInt)) then
1503		Info(InfoSimpcomp,1,"SCDifferenceCycleExpand: invalid difference cycle.");
1504		return fail;
1505	fi;
1506
1507	modulus:=Sum(diffcycle);
1508	rs:=[0];
1509	for i in [1..Length(diffcycle)-1] do
1510		rs[i+1]:=(rs[i]+diffcycle[i]) mod modulus;
1511	od;
1512
1513	orbit:=[Set(rs)];
1514	for i in [1..modulus-1] do
1515		AddSet(orbit,Set((rs+i) mod modulus));
1516	od;
1517
1518	return SCFromFacets(orbit+1);
1519end);
1520
1521################################################################################
1522##<#GAPDoc Label="SCFromDifferenceCycles">
1523## <ManSection>
1524## <Meth Name="SCFromDifferenceCycles" Arg="diffcycles"/>
1525## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
1526## <Description>
1527## Creates a simplicial complex object from the list of difference cycles provided. If <Arg>diffcycles</Arg> is of length <M>1</M> the computation is equivalent to the one in <Ref Func="SCDifferenceCycleExpand"/>. Otherwise the induced modulus (the sum of all entries of a difference cycle) of all cycles has to be equal and the union of all expanded difference cycles is returned.<P/>
1528## A <M>n</M>-dimensional difference cycle <M>D = (d_1 : \ldots : d_{n+1})</M> induces a simplex <M>\Delta = ( v_1 , \ldots , v_{n+1} )</M> by <M>v_1 = d_1</M>, <M>v_i = v_{i-1} + d_i</M> and a cyclic group action by <M>\mathbb{Z}_{\sigma}</M> where <M>\sigma = \sum d_i</M> is the modulus of <M>D</M>. The function returns the <M>\mathbb{Z}_{\sigma}</M>-orbit of <M>\Delta</M>.<P/>
1529## Note that modulo operations in &GAP; are often a little bit cumbersome, since all integer ranges usually start from <M>1</M>.
1530## <Example>
1531## gap> c:=SCFromDifferenceCycles([[1,1,6],[2,3,3]]);;
1532## gap> c.F;
1533## [ 8, 24, 16 ]
1534## gap> c.Homology;
1535## [ [ 0, [  ] ], [ 2, [  ] ], [ 1, [  ] ] ]
1536## gap> c.Chi;
1537## 0
1538## gap> c.HasBoundary;
1539## false
1540## gap> SCIsPseudoManifold(c);
1541## true
1542## gap> SCIsManifold(c);
1543## #I  SCIsManifold: link is sphere.
1544## #I  SCIsManifold: transitive automorphism group, checking only one link.
1545## true
1546## </Example>
1547## </Description>
1548## </ManSection>
1549##<#/GAPDoc>
1550################################################################################
1551InstallMethod(SCFromDifferenceCycles,
1552"for List of difference cycles",
1553[IsList],
1554function(diffcycles)
1555
1556	local modulus,expanded,complex,facets;
1557
1558	if(Length(diffcycles)<1 or not ForAll(diffcycles,IsList)) then
1559		Info(InfoSimpcomp,1,"SCFromDifferenceCycles: invalid difference cycle list.");
1560		return fail;
1561	fi;
1562
1563	modulus:=Sum(diffcycles[1]);
1564	expanded:=List(diffcycles,SCDifferenceCycleExpand);
1565
1566	if(ForAny(diffcycles,x->Sum(x)<>modulus) or fail in expanded) then
1567		Info(InfoSimpcomp,1,"SCFromDifferenceCycles: invalid difference cycle in arguments.");
1568		return fail;
1569	fi;
1570
1571        facets:=List(expanded,SCFacets);
1572	complex:=SC(Union(facets));
1573
1574	if complex=fail then
1575		return fail;
1576	fi;
1577	SetSCDifferenceCycles(complex,diffcycles);
1578	SCRename(complex,Concatenation("complex from diffcycles ",String(diffcycles)));
1579
1580	return complex;
1581end);
1582
1583################################################################################
1584##<#GAPDoc Label="SCDifferenceCycleCompress">
1585## <ManSection>
1586## <Func Name="SCDifferenceCycleCompress" Arg="simplex,modulus"/>
1587## <Returns> list with possibly duplicate entries upon success, <K>fail</K> otherwise.</Returns>
1588## <Description>
1589## A difference cycle is returned, i. e. a list of integer values of length <M>(d+1)</M>, if <M>d</M> is the dimension of <Arg>simplex</Arg>, and a sum equal to <Arg>modulus</Arg>. In some sense this is the inverse operation of <Ref Func="SCDifferenceCycleExpand"/>.
1590## <Example>
1591## gap> sphere:=SCBdSimplex(4);;
1592## gap> gens:=SCGenerators(sphere);
1593## [ [ [ 1, 2, 3, 4 ], [ [ 5 ] ] ] ]
1594## gap> diffcycle:=SCDifferenceCycleCompress(gens[1][1],5);
1595## [ 1, 1, 1, 2 ]
1596## gap> c:=SCDifferenceCycleExpand([1,1,1,2]);;
1597## gap> c.Facets;
1598## [ [ 1, 2, 3, 4 ], [ 1, 2, 3, 5 ], [ 1, 2, 4, 5 ], [ 1, 3, 4, 5 ],
1599##   [ 2, 3, 4, 5 ] ]
1600## </Example>
1601## </Description>
1602## </ManSection>
1603##<#/GAPDoc>
1604################################################################################
1605InstallGlobalFunction(SCDifferenceCycleCompress,
1606	function(simplex,modulus)
1607	local dc,i,j,sum;
1608
1609	if(Length(simplex)<2 or modulus<2 or not ForAll(simplex,x->x>=0)) then
1610		Info(InfoSimpcomp,1,"SCDifferenceCycleCompress: invalid simplex or simplex labeling.");
1611		return fail;
1612	fi;
1613
1614	dc:=[];
1615	sum:=0;
1616	for i in [1..Length(simplex)-1] do
1617		dc[i]:=AbsoluteValue(simplex[i+1]-simplex[i]);
1618		sum:=sum+dc[i];
1619	od;
1620
1621	dc[Length(simplex)]:=-sum mod modulus;
1622	return Set(Orbit(CyclicGroup(IsPermGroup,Length(simplex)),dc,Permuted))[1];
1623end);
1624
1625################################################################################
1626##<#GAPDoc Label="SCStronglyConnectedComponents">
1627## <ManSection>
1628## <Meth Name="SCStronglyConnectedComponents" Arg="complex"/>
1629## <Returns> a list of simplicial complexes of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
1630## <Description>
1631## Computes all strongly connected components of a pure simplicial complex.
1632## <Example>
1633## gap> c:=SC([[1,2,3],[2,3,4],[4,5,6],[5,6,7]]);;
1634## gap> comps:=SCStronglyConnectedComponents(c);
1635## [ [SimplicialComplex
1636##
1637##      Properties known: Dim, Facets, Name, VertexLabels.
1638##
1639##      Name="Strongly connected component #1 of unnamed complex m"
1640##      Dim=2
1641##
1642##     /SimplicialComplex], [SimplicialComplex
1643##
1644##      Properties known: Dim, Facets, Name, VertexLabels.
1645##
1646##      Name="Strongly connected component #3 of unnamed complex m"
1647##      Dim=2
1648##
1649##     /SimplicialComplex] ]
1650## gap> comps[1].Facets;
1651## [ [ 1, 2, 3 ], [ 2, 3, 4 ] ]
1652## gap> comps[2].Facets;
1653## [ [ 4, 5, 6 ], [ 5, 6, 7 ] ]
1654## </Example>
1655## </Description>
1656## </ManSection>
1657##<#/GAPDoc>
1658################################################################################
1659InstallMethod(SCStronglyConnectedComponents,
1660"for SCSimplicialComplex and IsEmpty",
1661[SCIsSimplicialComplex and IsEmpty],
1662function(complex)
1663	SetSCIsStronglyConnected(complex,true);
1664	return [SCEmpty()];
1665end);
1666
1667InstallMethod(SCStronglyConnectedComponents,
1668"for SCSimplicialComplex",
1669[SCIsSimplicialComplex],
1670function(complex)
1671
1672	local ispure, i, j, flag, untreated, allComponents, curComponent, boundary, faces, labels, dim, facets, name;
1673
1674
1675	labels:=SCVertices(complex);
1676	if(labels=fail) then
1677		Info(InfoSimpcomp,1,"SCStronglyConnectedComponents: argument lacks vertex labels.");
1678		return fail;
1679	fi;
1680
1681	dim := SCDim(complex);
1682	if dim = fail then
1683		return fail;
1684	fi;
1685
1686	ispure := SCIsPure(complex);
1687	if ispure = fail then
1688		return fail;
1689	fi;
1690
1691	if not ispure then
1692		Info(InfoSimpcomp,1,"SCStronglyConnectedComponents: argument must be a pure simplicial complex.");
1693		return fail;
1694	fi;
1695
1696	if dim = 0 then
1697		facets:=SCFacets(complex);
1698		if facets = fail then
1699			return fail;
1700		fi;
1701		allComponents := List(facets,x->SC([x]));
1702		if fail in allComponents then
1703			return fail;
1704		fi;
1705		SetSCIsStronglyConnected(complex,Length(allComponents)=1);
1706		return allComponents;
1707	fi;
1708
1709	untreated:=SCIntFunc.DeepCopy(SCFacetsEx(complex));
1710	if untreated=fail then
1711		return fail;
1712	fi;
1713
1714	allComponents :=[];
1715	while untreated<>[] do
1716		curComponent:=[untreated[1]];
1717		Remove(untreated,1);
1718		flag:=0;
1719		while flag=0 do
1720			flag:=1;
1721			boundary:=SCBoundary(SC(curComponent));
1722			faces:=SCFacets(boundary);
1723			if faces=fail then
1724				return fail;
1725			fi;
1726			for i in faces do
1727				for j in Reversed([1..Size(untreated)]) do
1728					if IsSubset(untreated[j],i) then
1729						flag:=0;
1730						Add(curComponent,untreated[j]);
1731						Remove(untreated,j);
1732					fi;
1733				od;
1734			od;
1735		od;
1736		AddSet(allComponents,curComponent);
1737	od;
1738
1739
1740
1741	name:=SCName(complex);
1742	if(name<>fail and Size(allComponents)>0) then
1743		for i in [1..Length(allComponents)] do
1744			allComponents[i]:=SCFromFacets(SCIntFunc.RelabelSimplexList(allComponents[i],labels));
1745			SCRename(allComponents[i],Concatenation(["Strongly connected component #",String(i)," of ",name]));
1746		od;
1747	fi;
1748
1749	SetSCIsStronglyConnected(complex,Length(allComponents)=1);
1750	return allComponents;
1751
1752end);
1753
1754################################################################################
1755##<#GAPDoc Label="SCConnectedComponents">
1756## <ManSection>
1757## <Meth Name="SCConnectedComponents" Arg="complex"/>
1758## <Returns> a list of simplicial complexes of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
1759## <Description>
1760## Computes all connected components of an arbitrary simplicial complex.
1761## <Example>
1762## gap> c:=SC([[1,2,3],[3,4,5],[4,5,6,7,8]]);;
1763## gap> SCRename(c,"connected complex");;
1764## gap> SCConnectedComponents(c);
1765## [ [SimplicialComplex
1766##
1767##      Properties known: Dim, Facets, Name, VertexLabels.
1768##
1769##      Name="Connected component #1 of connected complex"
1770##      Dim=4
1771##
1772##     /SimplicialComplex] ]
1773## gap> c:=SC([[1,2,3],[4,5],[6,7,8]]);;
1774## gap> SCRename(c,"non-connected complex");;
1775## gap> SCConnectedComponents(c);
1776## [ [SimplicialComplex
1777##
1778##      Properties known: Dim, Facets, Name, VertexLabels.
1779##
1780##      Name="Connected component #1 of non-connected complex"
1781##      Dim=2
1782##
1783##     /SimplicialComplex], [SimplicialComplex
1784##
1785##      Properties known: Chi, Dim, Facets, Name, VertexLabels.
1786##
1787##      Name="Connected component #2 of non-connected complex"
1788##      Dim=1
1789##      Chi=0
1790##
1791##     /SimplicialComplex], [SimplicialComplex
1792##
1793##      Properties known: Dim, Facets, Name, VertexLabels.
1794##
1795##      Name="Connected component #3 of non-connected complex"
1796##      Dim=2
1797##
1798##     /SimplicialComplex] ]
1799## </Example>
1800## </Description>
1801## </ManSection>
1802##<#/GAPDoc>
1803################################################################################
1804InstallMethod(SCConnectedComponents,
1805"for SCPolyhedralComplex and IsEmpty",
1806[SCIsPolyhedralComplex and IsEmpty],
1807function(complex)
1808	SetSCIsConnected(complex,true);
1809	return [SCEmpty()];
1810end);
1811
1812InstallMethod(SCConnectedComponents,
1813"for SCSimplicialComplex",
1814[SCIsSimplicialComplex],
1815function(complex)
1816
1817	local vertices, star, conncomps, verticesComponent, innerVertices, treatedVertices, name, i, labels, span, facets, sc;
1818
1819
1820	labels:=SCVertices(complex);
1821	if(labels=fail) then
1822		Info(InfoSimpcomp,1,"SCConnectedComponents: complex lacks vertex labels.");
1823		return fail;
1824	fi;
1825
1826	facets:=SCFacetsEx(complex);
1827	vertices:=SCVerticesEx(complex);
1828	if facets=fail or vertices=fail then
1829		return fail;
1830	fi;
1831
1832	conncomps:=[];
1833	conncomps:=[];
1834	while vertices<>[] do
1835		innerVertices:=[vertices[1]];
1836		treatedVertices:=[];
1837		verticesComponent:=[];
1838		while verticesComponent<>vertices and innerVertices<>[] do
1839			star:=Filtered(facets,x->innerVertices[1] in x);
1840			AddSet(treatedVertices,innerVertices[1]);
1841			RemoveSet(innerVertices,innerVertices[1]);
1842			innerVertices:=Union(innerVertices,Difference(Union(star),treatedVertices));
1843			verticesComponent:=Union(verticesComponent,Union(star));
1844		od;
1845		span:=Filtered(facets,x->IsSubset(verticesComponent,x));
1846		Add(conncomps,span);
1847		vertices:=Difference(vertices,verticesComponent);
1848	od;
1849
1850	name:=SCName(complex);
1851	if name = fail then
1852		return fail;
1853	fi;
1854
1855	if(Size(conncomps)>0) then
1856		for i in [1..Length(conncomps)] do
1857			conncomps[i]:=SCFromFacets(SCIntFunc.RelabelSimplexList(conncomps[i],labels));
1858			SCRename(conncomps[i],Concatenation(["Connected component #",String(i)," of ",name]));
1859		od;
1860	fi;
1861
1862	SetSCIsConnected(complex,Size(conncomps)=1);
1863	return conncomps;
1864
1865end);
1866
1867SCIntFunc.AGL1p:=function(p)
1868
1869	local b,factor,start,i,j,perm,t,l,G;
1870
1871	if(not IsPrime(p) or p < 5) then
1872		Info(InfoSimpcomp,1,"SCAGL1: argument must be a prime > 3.");
1873		return fail;
1874	fi;
1875
1876	factor:=0;
1877	for j in [2..p-2] do
1878		if Gcd(j,p-1) = 1 then
1879			b:=[];
1880			b[1]:=1;
1881			b[2]:=j;
1882			start:=j;
1883			i:=3;
1884			while start <> 1 and i < p do
1885				start:=start*j mod p;
1886				b[i]:=start;
1887				i:=i+1;
1888			od;
1889			if i > p then
1890				Info(InfoSimpcomp,1,"SCAGL1: no generator found.");
1891				return fail;
1892			fi;
1893			if Size(b) = p-1 then
1894				factor:=j;
1895				break;
1896			fi;
1897		fi;
1898	od;
1899	if factor = 0 then
1900		Info(InfoSimpcomp,1,"SCAGL1: no generator found.");
1901		return fail;
1902	fi;
1903
1904	perm:=List([1..p-1],x->factor*x mod p)+1;
1905	perm:=Concatenation([1],perm);
1906	l:=PermList(perm);
1907	t:=PermList(Concatenation([2..p],[1]));
1908	G:=Group(t,l);
1909	SetName(G,Concatenation("AGL(1,",String(p),")"));
1910
1911	return G;
1912
1913end;
1914
1915################################################################################
1916##<#GAPDoc Label="SCSeriesAGL">
1917## <ManSection>
1918## <Func Name="SCSeriesAGL" Arg="p"/>
1919## <Returns> a permutation group and a list of <M>5</M>-tuples of integers upon success, <K>fail</K> otherwise.</Returns>
1920## <Description>
1921## For a given prime <Arg>p</Arg> the automorphism group (AGL<M>(1,p)</M>) and the generators of all members of the series of <M>2</M>-transitive combinatorial <M>4</M>-pseudomanifolds with <Arg>p</Arg> vertices from <Cite Key="Spreer10Diss"/>, Section 5.2, is computed. The affine linear group AGL<M>(1,p)</M> is returned as the first argument. If no member of the series with <Arg>p</Arg> vertices exists only the group is returned.
1922## <Example>
1923## gap> gens:=SCSeriesAGL(17);
1924## [ AGL(1,17), [ [ 1, 2, 4, 8, 16 ] ] ]
1925## gap> c:=SCFromGenerators(gens[1],gens[2]);;
1926## gap> SCIsManifold(SCLink(c,1));
1927## true
1928## </Example>
1929## <Example>
1930## gap> List([19..23],x->SCSeriesAGL(x));
1931## #I  SCSeriesAGL: argument must be a prime > 13.
1932## #I  SCSeriesAGL: argument must be a prime > 13.
1933## #I  SCSeriesAGL: argument must be a prime > 13.
1934## [ [ AGL(1,19), [ [ 1, 2, 10, 12, 17 ] ] ], fail, fail, fail,
1935##   [ AGL(1,23), [ [ 1, 2, 7, 9, 19 ], [ 1, 2, 4, 8, 22 ] ] ] ]
1936## gap> for i in [80000..80100] do if IsPrime(i) then Print(i,"\n"); fi; od;
1937## 80021
1938## 80039
1939## 80051
1940## 80071
1941## 80077
1942## gap> SCSeriesAGL(80021);
1943## [ AGL(1,80021), [  ] ]
1944## gap> SCSeriesAGL(80039);
1945## [ AGL(1,80039), [ [ 1, 2, 6496, 73546, 78018 ] ] ]
1946## gap> SCSeriesAGL(80051);
1947## [ AGL(1,80051), [ [ 1, 2, 31498, 37522, 48556 ] ] ]
1948## gap> SCSeriesAGL(80071);
1949## [ AGL(1,80071), [  ] ]
1950## gap> SCSeriesAGL(80077);
1951## [ AGL(1,80077), [ [ 1, 2, 4126, 39302, 40778 ] ] ]
1952## </Example>
1953## </Description>
1954## </ManSection>
1955##<#/GAPDoc>
1956################################################################################
1957InstallGlobalFunction(SCSeriesAGL,
1958	function(p)
1959
1960	local b,factor,start,i,j,perm,t,l,candidates,c,G;
1961
1962	if(not IsPrime(p) or p <= 14) then
1963		Info(InfoSimpcomp,1,"SCSeriesAGL: argument must be a prime > 13.");
1964		return fail;
1965	fi;
1966
1967	factor:=0;
1968	for j in [2..p-2] do
1969		if Gcd(j,p-1) = 1 then
1970			b:=[];
1971			b[1]:=1;
1972			b[2]:=j;
1973			start:=j;
1974			i:=3;
1975			while start <> 1 and i < p do
1976				start:=start*j mod p;
1977				b[i]:=start;
1978				i:=i+1;
1979			od;
1980			if i > p then
1981				Info(InfoSimpcomp,1,"SCSeriesAGL: no generator found.");
1982				return fail;
1983			fi;
1984			if Size(b) = p-1 then
1985				factor:=j;
1986				break;
1987			fi;
1988		fi;
1989	od;
1990	if factor = 0 then
1991		Info(InfoSimpcomp,1,"SCSeriesAGL: no generator found.");
1992		return fail;
1993	fi;
1994
1995	perm:=List([1..p-1],x->factor*x mod p)+1;
1996	perm:=Concatenation([1],perm);
1997	l:=PermList(perm);
1998	t:=PermList(Concatenation([2..p],[1]));
1999	G:=Group(t,l);
2000	SetName(G,Concatenation("AGL(1,",String(p),")"));
2001
2002	candidates:=[];
2003	for i in [2..(p-1)] do
2004
2005		if ((1-b[((2*(i-1)-0) mod (p-1)) + 1]) mod p = b[((3*(i-1)-0) mod (p-1)) +1]) then
2006			c:=[0,1,b[i],b[((2*(i-1)-0) mod (p-1)) + 1],b[((3*(i-1)-0) mod (p-1)) +1]];
2007			Sort(c);
2008			c:=c+1;
2009			Add(candidates,c);
2010		fi;
2011	od;
2012
2013	if candidates=[] then
2014		return G;
2015	else
2016		return [G,candidates];
2017	fi;
2018
2019end);
2020
2021
2022################################################################################
2023##<#GAPDoc Label="SCSeriesBid">
2024## <ManSection>
2025## <Func Name="SCSeriesBid" Arg="i,d"/>
2026## <Returns> a simplicial complex upon success, <K>fail</K> otherwise.</Returns>
2027## <Description>
2028## Constructs the complex <M>B(i,d)</M> as described in <Cite Key="Klee11CentSymmMnfFewVert" />, cf. <Cite Key="Effenberger10Diss" />, <Cite Key="Sparla99LBTComb2kMnf" />. The complex <M>B(i,d)</M> is a <M>i</M>-Hamiltonian subcomplex of the <M>d</M>-cross polytope and its boundary topologically is a sphere product <M>S^i\times S^{d-i-2}</M> with vertex transitive automorphism group.
2029## <Example>
2030## gap> b26:=SCSeriesBid(2,6);
2031## gap> s2s2:=SCBoundary(b26);
2032## gap> SCFVector(s2s2);
2033## gap> SCAutomorphismGroup(s2s2);
2034## gap> SCIsManifold(s2s2);
2035## gap> SCHomology(s2s2);
2036## </Example>
2037## </Description>
2038## </ManSection>
2039##<#/GAPDoc>
2040################################################################################
2041InstallGlobalFunction(SCSeriesBid,
2042	function(i,d)
2043	local facets,b,changes,f,j,c;
2044
2045	if(not IsInt(i) or not IsPosInt(d) or i<0) then
2046		Info(InfoSimpcomp,1,"SCSeriesBid: argument i must be a non-negative integer between 0 and d-2, argument d a positive integer.");
2047		return fail;
2048	fi;
2049
2050	#returns list of facets with exactly b "changes"
2051	changes:=function(b)
2052		local i,o,c;
2053		o:=b[1];
2054		c:=0;
2055		for i in b{[2..Length(b)]} do
2056			if(i<>o) then
2057				c:=c+1;
2058				o:=i;
2059			fi;
2060		od;
2061		return c;
2062	end;
2063
2064	#generate facet list
2065	facets:=[];
2066	for b in Cartesian(ListWithIdenticalEntries(d,[0,1])) do
2067		if(changes(b)<=i) then
2068			#build facet
2069			f:=[];
2070			for j in [1..Length(b)] do
2071				if(b[j]=1) then
2072					f[j]:=d+j;
2073				else
2074					f[j]:=j;
2075				fi;
2076			od;
2077
2078			Add(facets,f);
2079		fi;
2080	od;
2081
2082	c:=SCFromFacets(facets);
2083	SCRename(c,Concatenation("B(",String(i),",",String(d),")"));
2084	SCSetReference(c,"S. Klee and I. Novik, Centrally symmetric manifolds with few vertices, arXiv:1102.0542v1 [math.CO], Preprint, 15 pages, 2011.");
2085	return c;
2086end);
2087
2088
2089
2090
2091################################################################################
2092##<#GAPDoc Label="SCSeriesC2n">
2093## <ManSection>
2094## <Func Name="SCSeriesC2n" Arg="n"/>
2095## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2096## <Description>
2097## Generates the combinatorial <M>3</M>-manifold <M>C_{2n}</M>, <M>n \geq 8</M>, with <M>2n</M> vertices from <Cite Key="Spreer10Diss"/>, Section 4.5.3 and Section 5.2. The complex is homeomorphic to <M>S^2 \times S^1</M> for <M>n</M> odd and homeomorphic to <M>S^2 \dtimes S^1</M> in case <M>n</M> is an even number. In the latter case <M>C_{2n}</M> is isomorphic to <M>D_{2n}</M> from <Ref Func="SCSeriesD2n"/>. The complexes are believed to appear as the vertex links of some of the members of the series of <M>2</M>-transitive <M>4</M>-pseudomanifolds from <Ref Func="SCSeriesAGL"/>. Internally calls <Ref Func="SCFromDifferenceCycles"/>.
2098## <Example>
2099## gap> c:=SCSeriesC2n(8);
2100## [SimplicialComplex
2101##
2102##  Properties known: Dim, Facets, Name, VertexLabels.
2103##
2104##  Name="C_16 = { (1:1:3:11),(1:1:11:3),(1:3:1:11),(2:3:2:9),(2:5:2:7) }"
2105##  Dim=3
2106##
2107## /SimplicialComplex]
2108## gap> SCGenerators(c);
2109## [ [ [ 1, 2, 3, 6 ], 32 ], [ [ 1, 2, 5, 6 ], 16 ], [ [ 1, 3, 6, 8 ], 16 ],
2110##   [ [ 1, 3, 8, 10 ], 16 ] ]
2111## </Example>
2112## <Example>
2113## gap> c:=SCSeriesC2n(8);;
2114## gap> d:=SCSeriesD2n(8);
2115## [SimplicialComplex
2116##
2117##  Properties known: Dim, Facets, Name, VertexLabels.
2118##
2119##  Name="D_16 = { (1:1:1:13),(1:2:11:2),(3:4:5:4),(2:3:4:7),(2:7:4:3) }"
2120##  Dim=3
2121##
2122## /SimplicialComplex]
2123## gap> SCIsIsomorphic(c,d);
2124## true
2125## gap> c:=SCSeriesC2n(11);;
2126## gap> d:=SCSeriesD2n(11);;
2127## gap> c.Homology;
2128## [ [ 0, [  ] ], [ 1, [  ] ], [ 1, [  ] ], [ 1, [  ] ] ]
2129## gap> d.Homology;
2130## [ [ 0, [  ] ], [ 1, [  ] ], [ 0, [ 2 ] ], [ 0, [  ] ] ]
2131## </Example>
2132## </Description>
2133## </ManSection>
2134##<#/GAPDoc>
2135################################################################################
2136InstallGlobalFunction(SCSeriesC2n,
2137	function(n)
2138
2139	local c;
2140
2141	if(not IsInt(n) or n < 8) then
2142		Info(InfoSimpcomp,1,"SCSeriesC2n: argument must be an integer > 7.");
2143		return fail;
2144	fi;
2145
2146	c:=SCFromDifferenceCycles([[1,1,n-5,n+3],[1,1,n+3,n-5],[1,n-5,1,n+3],[2,n-5,2,n+1],[2,n-3,2,n-1]]);
2147	SCRename(c,Concatenation(["C_",String(2*n)," = { (1:1:",String(n-5),":",String(n+3),"),(1:1:",String(n+3),":",String(n-5),"),(1:",String(n-5),":1:",String(n+3),"),(2:",String(n-5),":2:",String(n+1),"),(2:",String(n-3),":2:",String(n-1),") }"]));
2148	if not IsInt(n/2) then
2149		SetSCTopologicalType(c,"S^2 x S^1");
2150	else
2151		SetSCTopologicalType(c,"S^2 ~ S^1");
2152	fi;
2153
2154	return c;
2155
2156end);
2157
2158################################################################################
2159##<#GAPDoc Label="SCSeriesD2n">
2160## <ManSection>
2161## <Func Name="SCSeriesD2n" Arg="n"/>
2162## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2163## <Description>
2164## Generates the combinatorial <M>3</M>-manifold <M>D_{2n}</M>, <M>n \geq 8</M>, <M>n \neq 9</M>, with <M>2n</M> vertices from <Cite Key="Spreer10Diss"/>, Section 4.5.3 and Section 5.2. The complex is homeomorphic to <M>S^2 \dtimes S^1</M>. In the case that <M>n</M> is even <M>D_{2n}</M> is isomorphic to <M>C_{2n}</M> from <Ref Func="SCSeriesC2n"/>. The complexes are believed to appear as the vertex links of some of the members of the series of <M>2</M>-transitive <M>4</M>-pseudomanifolds from <Ref Func="SCSeriesAGL"/>. Internally calls <Ref Func="SCFromDifferenceCycles"/>.
2165## <Example>
2166## gap> d:=SCSeriesD2n(15);
2167## [SimplicialComplex
2168##
2169##  Properties known: Dim, Facets, Name, VertexLabels.
2170##
2171##  Name="D_30 = { (1:1:1:27),(1:2:25:2),(3:11:5:11),(2:3:11:14),(2:14:11:3) }"
2172##  Dim=3
2173##
2174## /SimplicialComplex]
2175## gap> SCAutomorphismGroup(d);
2176## TransitiveGroup(30,14) = t30n14
2177## gap> StructureDescription(last);
2178## "D60"
2179## </Example>
2180## <Example>
2181## gap> c:=SCSeriesC2n(8);;
2182## gap> d:=SCSeriesD2n(8);
2183## [SimplicialComplex
2184##
2185##  Properties known: Dim, Facets, Name, VertexLabels.
2186##
2187##  Name="D_16 = { (1:1:1:13),(1:2:11:2),(3:4:5:4),(2:3:4:7),(2:7:4:3) }"
2188##  Dim=3
2189##
2190## /SimplicialComplex]
2191## gap> SCIsIsomorphic(c,d);
2192## true
2193## gap> c:=SCSeriesC2n(11);;
2194## gap> d:=SCSeriesD2n(11);;
2195## gap> c.Homology;
2196## [ [ 0, [  ] ], [ 1, [  ] ], [ 1, [  ] ], [ 1, [  ] ] ]
2197## gap> d.Homology;
2198## [ [ 0, [  ] ], [ 1, [  ] ], [ 0, [ 2 ] ], [ 0, [  ] ] ]
2199## </Example>
2200## </Description>
2201## </ManSection>
2202##<#/GAPDoc>
2203################################################################################
2204InstallGlobalFunction(SCSeriesD2n,
2205	function(n)
2206
2207	local c;
2208
2209	if(not IsInt(n) or n < 8 or n=9) then
2210		Info(InfoSimpcomp,1,"SCSeriesD2n: argument must be an integer > 7 not equal to 9.");
2211		return fail;
2212	fi;
2213
2214	c:=SCFromDifferenceCycles([[1,1,1,2*n-3],[1,2,2*n-5,2],[3,n-4,5,n-4],[2,3,n-4,n-1],[2,n-1,n-4,3]]);
2215	SCRename(c,Concatenation(["D_",String(2*n)," = { (1:1:1:",String(2*n-3),"),(1:2:",String(2*n-5),":2),(3:",String(n-4),":5:",String(n-4),"),(2:3:",String(n-4),":",String(n-1),"),(2:",String(n-1),":",String(n-4),":3) }"]));
2216	SetSCTopologicalType(c,"S^2 ~ S^1");
2217
2218	return c;
2219
2220end);
2221
2222################################################################################
2223##<#GAPDoc Label="SCSeriesKu">
2224## <ManSection>
2225## <Func Name="SCSeriesKu" Arg="n"/>
2226## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2227## <Description>
2228## Computes the symmetric orientable sphere bundle Ku<M>(n)</M> with <M>4n</M> vertices from <Cite Key="Spreer10Diss"/>, Section 4.5.2. The series is defined as a generalization of the slicings from <Cite Key="Spreer10Diss"/>, Section 3.3.
2229## <Example>
2230## gap> c:=SCSeriesKu(4);
2231## gap> SCSlicing(c,[[1,2,3,4,9,10,11,12],[5,6,7,8,13,14,15,16]]);
2232## gap> Mminus:=SCSpan(c,[1,2,3,4,9,10,11,12]);;
2233## gap> Mplus:=SCSpan(c,[5,6,7,8,13,14,15,16]);;
2234## gap> SCCollapseGreedy(Mminus).Facets;
2235## gap> SCCollapseGreedy(Mplus).Facets;
2236## </Example>
2237## </Description>
2238## </ManSection>
2239##<#/GAPDoc>
2240################################################################################
2241InstallGlobalFunction(SCSeriesKu,
2242function(n)
2243
2244	local G, orbs, tmp, perm, i, c;
2245
2246	if(not IsInt(n) or n < 3) then
2247		Info(InfoSimpcomp,1,"SCSeriesKu: argument must be an integer > 2.");
2248		return fail;
2249	fi;
2250
2251	perm:=[];
2252	tmp:=[];
2253	for i in [1..n] do
2254		tmp[i]:=2*n-i+1;
2255		tmp[n+i]:=n-i+1;
2256		tmp[2*n+i]:=4*n-i+1;
2257		tmp[3*n+i]:=3*n-i+1;
2258	od;
2259	perm[1]:=PermList(tmp);
2260
2261	tmp:=[];
2262	for i in [1..n] do
2263		tmp[i]:=n+i;
2264		if i < n then
2265			tmp[n+i]:=i+1;
2266			tmp[3*n+i]:=2*n+i+1;
2267		elif i = n then
2268			tmp[n+i]:=1;
2269			tmp[3*n+i]:=2*n+1;
2270		fi;
2271		tmp[2*n+i]:=3*n+i;
2272
2273	od;
2274	perm[2]:=PermList(tmp);
2275
2276	tmp:=[];
2277	for i in [1..2*n] do
2278		tmp[i]:=4*n-i+1;
2279		tmp[4*n-i+1]:=i;
2280	od;
2281	perm[3]:=PermList(tmp);
2282
2283        if perm = [] then
2284          G:=Group(());
2285        else
2286          G:=Group(perm);
2287        fi;
2288	c:=SCFromGenerators(G,[[1,2,n+1,2*n+1],[1,2,2*n+1,2*n+2],[1,n+1,2*n+1,4*n]]);
2289	SCRename(c,Concatenation(["Sl_",String(4*n)," = G{ [1,2,",String(n+1),",",String(2*n+1),"],[1,2,",String(2*n+1),",",String(2*n+2),"],[1,",String(n+1),",",String(2*n+1),",",String(4*n),"] }"]));
2290	return c;
2291
2292end);
2293
2294################################################################################
2295##<#GAPDoc Label="SCSeriesCSTSurface">
2296## <ManSection>
2297## <Func Name="SCSeriesCSTSurface" Arg="l,[j,]2k"/>
2298## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2299## <Description>
2300## <C>SCSeriesCSTSurface(l,j,2k)</C> generates the centrally symmetric transitive (cst) surface <M>S_{(l,j,2k)}</M>, <C>SCSeriesCSTSurface(l,2k)</C> generates the cst surface <M>S_{(l,2k)}</M> from <Cite Key="Spreer10PartBetaK"/>, Section 4.4.
2301## <Example>
2302## gap> SCSeriesCSTSurface(2,4,14);
2303## [SimplicialComplex
2304##
2305##  Properties known: Dim, Facets, Name, VertexLabels.
2306##
2307##  Name="cst surface S_{(2,4,14)} = { (2:4:8),(2:8:4) }""
2308##  Dim=2
2309##
2310## /SimplicialComplex]
2311## gap> last.Homology;
2312## [ [ 1, [  ] ], [ 4, [  ] ], [ 2, [  ] ] ]
2313## gap> SCSeriesCSTSurface(2,10);
2314## [SimplicialComplex
2315##
2316##  Properties known: Dim, Facets, Name, VertexLabels.
2317##
2318##  Name="cst surface S_{(2,10)} = { (2:2:6),(3:3:4) }"
2319##  Dim=2
2320##
2321## /SimplicialComplex]
2322## gap> last.Homology;
2323## [ [ 0, [  ] ], [ 1, [ 2 ] ], [ 0, [  ] ] ]
2324## </Example>
2325## </Description>
2326## </ManSection>
2327##<#/GAPDoc>
2328################################################################################
2329InstallGlobalFunction(SCSeriesCSTSurface,
2330function(arg)
2331
2332	local n,l,j,S;
2333
2334	if Size(arg) < 2 or Size(arg) > 3 then
2335		Info(InfoSimpcomp,1,"SCSeriesCSTSurface: there must be either 2 or 3 arguments.");
2336		return fail;
2337	fi;
2338
2339	if Size(arg) = 3 then
2340		n:=arg[3];
2341		l:=arg[1];
2342		j:=arg[2];
2343		if not IsPosInt(l) or not IsPosInt(j) or not IsPosInt(n/2) or n < 3 or j = n/2 or l = n/2 or j+l = n/2 or l >= j  or j >= n-l-j then
2344			Info(InfoSimpcomp,1,"SCSeriesCSTSurface: 2k must be an even number, k>2, l,j and l+j must be different from k and l < j < 2k-l-j must hold.");
2345			return fail;
2346		fi;
2347		S:=SCFromDifferenceCycles([[l,j,n-l-j],[l,n-l-j,j]]);
2348		SCRename(S,Concatenation(["cst surface S_{(",String(l),",",String(j),",",String(n),")} = { (",String(l),":",String(j),":",String(n-l-j),"),(",String(l),":",String(n-l-j),":",String(j),") }"]));
2349		return S;
2350	elif Size(arg) = 2 then
2351		n:=arg[2];
2352		l:=arg[1];
2353		if not IsPosInt(l) or not IsPosInt(n/2) or n < 3 or l > (n/2-1)/2 then
2354			Info(InfoSimpcomp,1,"SCSeriesCSTSurface: 2k must be an even number, k > 2, and l <= (k-1)/2.");
2355			return fail;
2356		fi;
2357		S:=SCFromDifferenceCycles([[l,l,n-2*l],[n/2-l,n/2-l,2*l]]);
2358		SCRename(S,Concatenation(["cst surface S_{(",String(l),",",String(n),")} = { (",String(l),":",String(l),":",String(n-2*l),"),(",String(n/2-l),":",String(n/2-l),":",String(2*l),") }"]));
2359		return S;
2360	fi;
2361
2362end);
2363
2364################################################################################
2365##<#GAPDoc Label="SCSeriesHandleBody">
2366## <ManSection>
2367## <Func Name="SCSeriesHandleBody" Arg="d,n"/>
2368## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2369## <Description>
2370## <C>SCSeriesHandleBody(d,n)</C> generates a transitive <M>d</M>-dimensional handle body (<M>d \geq 3</M>) with <M>n</M> vertices (<M>n \geq 2d + 1</M>). The handle body is orientable if <M>d</M> is odd or if <M>d</M> and <M>n</M> are even, otherwise it is not orientable. The complex equals the difference cycle <M>(1 : \ldots : 1 : n-d)</M> To obtain the boundary complexes of <C>SCSeriesHandleBody(d,n)</C> use the function <Ref Func="SCSeriesBdHandleBody"/>. Internally calls <Ref Func="SCFromDifferenceCycles"/>.
2371## <Example>
2372## gap> c:=SCSeriesHandleBody(3,7);
2373## [SimplicialComplex
2374##
2375##  Properties known: Dim, Facets, Name, VertexLabels.
2376##
2377##  Name="Handle body B^2 x S^1"
2378##  Dim=3
2379##
2380## /SimplicialComplex]
2381## gap> SCAutomorphismGroup(c);
2382## PrimitiveGroup(7,2) = D(2*7)
2383## gap> bd:=SCBoundary(c);;
2384## gap> SCAutomorphismGroup(bd);
2385## PrimitiveGroup(7,4) = AGL(1, 7)
2386## gap> SCIsIsomorphic(bd,SCSeriesBdHandleBody(2,7));
2387## true
2388## </Example>
2389## </Description>
2390## </ManSection>
2391##<#/GAPDoc>
2392################################################################################
2393InstallGlobalFunction(SCSeriesHandleBody,
2394function(d,n)
2395
2396	local S;
2397
2398	if not IsPosInt(d) or not IsPosInt(n) or d < 3 or n < 2*d + 1 then
2399		Info(InfoSimpcomp,1,"SCSeriesHandleBody: the first argument d must be an integer >= 3, the second argument n must fulfill n >= 2d + 1");
2400		return fail;
2401	fi;
2402
2403	S:=SCFromDifferenceCycles([Concatenation(ListWithIdenticalEntries(d,1),[n-d])]);
2404	if IsInt(d/2) and not IsInt(n/2) then
2405		SCRename(S,Concatenation(["Handle body B^",String(d-1)," ~ S^1"]));
2406		SetSCTopologicalType(S,Concatenation(["B^",String(d-1)," ~ S^1"]));
2407		SetSCIsOrientable(S,false);
2408	else
2409		SCRename(S,Concatenation(["Handle body B^",String(d-1)," x S^1"]));
2410		SetSCTopologicalType(S,Concatenation(["B^",String(d-1)," x S^1"]));
2411		SetSCIsOrientable(S,true);
2412	fi;
2413	return S;
2414
2415end);
2416
2417################################################################################
2418##<#GAPDoc Label="SCSeriesBdHandleBody">
2419## <ManSection>
2420## <Func Name="SCSeriesBdHandleBody" Arg="d,n"/>
2421## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2422## <Description>
2423## <C>SCSeriesBdHandleBody(d,n)</C> generates a transitive <M>d</M>-dimensional sphere bundle (<M>d \geq 2</M>) with <M>n</M> vertices (<M>n \geq 2d + 3</M>) which coincides with the boundary of <Ref Func="SCSeriesHandleBody"/><C>(d,n)</C>. The sphere bundle is orientable if <M>d</M> is even or if <M>d</M> is odd and <M>n</M> is even, otherwise it is not orientable. Internally calls <Ref Func="SCFromDifferenceCycles"/>.
2424## <Example>
2425## gap> c:=SCSeriesBdHandleBody(2,7);
2426## [SimplicialComplex
2427##
2428##  Properties known: Dim, Facets, Name, VertexLabels.
2429##
2430##  Name="Sphere bundle S^1 x S^1"
2431##  Dim=2
2432##
2433## /SimplicialComplex]
2434## gap> SCLib.DetermineTopologicalType(c);
2435## [SimplicialComplex
2436##
2437##  Properties known: AltshulerSteinberg, AutomorphismGroup,
2438##                    AutomorphismGroupSize, AutomorphismGroupStructure,
2439##                    AutomorphismGroupTransitivity, Boundary, Chi,
2440##                    ConnectedComponents, Dim, DualGraph, F, Faces, Facets, G,
2441##                    Generators, H, HasBoundary, HasInterior, Homology,
2442##                    Interior, IsCentrallySymmetric, IsConnected,
2443##                    IsEulerianManifold, IsManifold, IsOrientable, IsPM, IsPure,\
2444##
2445##                    MinimalNonFaces, Name, Neighborliness, Orientation,
2446##                    Reference, StronglyConnected, VertexLabels, Vertices.
2447##
2448##  Name="T^2 (VT)"
2449##  Dim=2
2450##  AutomorphismGroupSize=42
2451##  AutomorphismGroupStructure="(C7 : C3) : C2"
2452##  AutomorphismGroupTransitivity=2
2453##  Chi=0
2454##  F=[ 7, 21, 14 ]
2455##  G=[ 3, 6 ]
2456##  H=[ 4, 10, -1 ]
2457##  HasBoundary=false
2458##  HasInterior=true
2459##  Homology=[ [ 0, [ ] ], [ 2, [ ] ], [ 1, [ ] ] ]
2460##  IsCentrallySymmetric=false
2461##  IsConnected=true
2462##  IsEulerianManifold=true
2463##  IsOrientable=true
2464##  IsPM=true
2465##  IsPure=true
2466##  Neighborliness=2
2467##
2468## /SimplicialComplex]
2469## gap> SCIsIsomorphic(c,SCSeriesHandleBody(3,7).Boundary);
2470## true
2471## </Example>
2472## </Description>
2473## </ManSection>
2474##<#/GAPDoc>
2475################################################################################
2476InstallGlobalFunction(SCSeriesBdHandleBody,
2477function(d,n)
2478
2479	local S;
2480
2481	if not IsPosInt(d) or not IsPosInt(n) or d < 2 or n < 2*d + 3 then
2482		Info(InfoSimpcomp,1,"SCSeriesBdHandleBody: the first argument d must be an integer >= 2, the second argument n must fulfill n >= 2d + 3");
2483		return fail;
2484	fi;
2485
2486	S:=SCBoundary(SCFromDifferenceCycles([Concatenation(ListWithIdenticalEntries(d+1,1),[n-d-1])]));
2487	if not IsInt(d/2) and not IsInt(n/2) then
2488		SCRename(S,Concatenation(["Sphere bundle S^",String(d-1)," ~ S^1"]));
2489		SetSCTopologicalType(S,Concatenation(["S^",String(d-1)," ~ S^1"]));
2490		SetSCIsOrientable(S,false);
2491	else
2492		SCRename(S,Concatenation(["Sphere bundle S^",String(d-1)," x S^1"]));
2493		SetSCTopologicalType(S,Concatenation(["S^",String(d-1)," x S^1"]));
2494		SetSCIsOrientable(S,true);
2495	fi;
2496	return S;
2497
2498end);
2499
2500
2501################################################################################
2502##<#GAPDoc Label="SCSeriesLe">
2503## <ManSection>
2504## <Func Name="SCSeriesLe" Arg="k"/>
2505## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2506## <Description>
2507## Generates the <Arg>k</Arg>-th member (<M>k \geq 7</M>) of the series <C>Le</C> from <Cite Key="Spreer10Diss"/>, Section 4.5.1. The series can be constructed as the generalization of the boundary of a genus <M>1</M> handlebody decomposition of the manifold <C>manifold_3_14_1_5</C> from the classification in <Cite Key="Lutz03TrigMnfFewVertVertTrans"/>.
2508## <Example>
2509## gap> c:=SCSeriesLe(7);
2510## [SimplicialComplex
2511##
2512##  Properties known: Dim, Facets, Name, VertexLabels.
2513##
2514##  Name="Le_14 = { (1:1:1:11),(1:2:4:7),(1:4:2:7),(2:5:2:5),(2:4:2:6) }"
2515##  Dim=3
2516##
2517## /SimplicialComplex]
2518## gap> d:=SCLib.DetermineTopologicalType(c);;
2519## gap> SCReference(d);
2520## "manifold_3_14_1_5 in F.H.Lutz: 'The Manifold Page', http://www.math.tu-berlin\
2521## .de/diskregeom/stellar/,\nF.H.Lutz: 'Triangulated manifolds with few vertices \
2522## and vertex-transitive group actions', Doctoral Thesis TU Berlin 1999, Shaker-V\
2523## erlag, Aachen 1999"
2524## gap>
2525## </Example>
2526## </Description>
2527## </ManSection>
2528##<#/GAPDoc>
2529################################################################################
2530InstallGlobalFunction(SCSeriesLe,
2531	function(k)
2532
2533	local gens,c,l;
2534
2535	if(not IsInt(k) or not k > 6) then
2536		Info(InfoSimpcomp,1,"SCSeriesLe: argument must be an integer > 6.");
2537		return fail;
2538	fi;
2539
2540	gens:=[[1,1,1,2*k-3],[1,2,k-3,k],[1,k-3,2,k],[2,1,k-3,k],[2,k-2,2,k-2],[2,k-3,2,k-1]];
2541	c:=SCFromDifferenceCycles(gens);
2542	SCRename(c,Concatenation(["Le_",String(2*k)," = { (1:1:1:",String(2*k-3),"),(1:2:",String(k-3),":",String(k),"),(1:",String(k-3),":2:",String(k),"),(2:1:",String(k-3),":",String(k),"),(2:",String(k-2),":2:",String(k-2),"),(2:",String(k-3),":2:",String(k-1),") }"]));
2543
2544	return c;
2545
2546end);
2547
2548
2549################################################################################
2550##<#GAPDoc Label="SCSeriesL">
2551## <ManSection>
2552## <Func Name="SCSeriesL" Arg="i,k"/>
2553## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2554## <Description>
2555## Generates the <Arg>k</Arg>-th member (<M>k \geq 0</M>) of the series <Arg>L^i</Arg>, <M>1 \leq i \leq 18</M>  from <Cite Key="Spreer10Diss"/>. The <M>18</M> series describe a complete classification of all series of cyclic <M>3</M>-manifolds with a fixed number of difference cycles of order <M>2</M> (i. e. there is a member of the series for every second integer, <M>f_0 (L^i (k+1) ) = f_0 (L^i (k)) +2</M>) and at least one member with less than <M>15</M> vertices where each series does not appear as a sub series of one of the series <M>K^i</M> from <Ref Func="SCSeriesK"/>.
2556## <Example>
2557## gap> cc:=List([1..18],x->SCSeriesL(x,0));;
2558## gap> Set(List(cc,x->x.F));
2559## [ [ 10, 45, 70, 35 ], [ 12, 60, 96, 48 ], [ 12, 66, 108, 54 ],
2560##   [ 14, 77, 126, 63 ], [ 14, 84, 140, 70 ], [ 14, 91, 154, 77 ] ]
2561## gap> cc:=List([1..18],x->SCSeriesL(x,10));;
2562## gap> Set(List(cc,x->x.IsManifold));
2563## [ true ]
2564## gap>
2565## </Example>
2566## </Description>
2567## </ManSection>
2568##<#/GAPDoc>
2569################################################################################
2570InstallGlobalFunction(SCSeriesL,
2571	function(i,k)
2572
2573	local dc,c;
2574
2575	if(not IsInt(k) or not k >= 0 or not i in [1..18]) then
2576		Info(InfoSimpcomp,1,"SCSeriesL: 'i' must be in [1..18], 'k' must be an integer >= 0.");
2577		return fail;
2578	fi;
2579
2580	dc:=[
2581		# n = 10
2582		[[1,1,3+k,5+k,],[1,1,4+k,4+k,],[1,3+k,2,4+k,],[2,3+k,2,3+k,]],
2583		[[1,1,3+k,5+k,],[1,1,5+k,3+k,],[1,3+k,1,5+k,],[2,3+k,2,3+k,]],
2584		[[1,3+k,1,5+k,],[1,3+k,2,4+k,],[1,4+k,2,3+k,],[2,3+k,2,3+k,]],
2585		# n = 12
2586		[[1,1,1,9+2*k,],[1,2,4+k,5+k,],[1,4+k,2,5+k,],[1,4+k,5+k,2,],[2,4+k,2,4+k,]],
2587		[[1,1,1,9+2*k,],[1,2,5+k,4+k,],[1,4+k,3,4+k,],[1,4+k,5+k,2,]],
2588		[[1,1,3+k,7+k,],[1,1,4+k,6+k,],[1,3+k,2,6+k,],[2,3+k,2,5+k,],[2,4+k,2,4+k,]],
2589		[[1,1,3+k,7+k,],[1,1,6+k,4+k,],[1,3+k,1,7+k,],[1,6+k,2,3+k,],[2,4+k,2,4+k,]],
2590		[[1,1,3+k,7+k,],[1,1,7+k,3+k,],[1,3+k,1,7+k,],[2,3+k,2,5+k,]],
2591		[[1,2,4+k,5+k,],[1,2,5+k,4+k,],[1,4+k,2,5+k,],[1,4+k,3,4+k,],[2,4+k,2,4+k,]],
2592		# n = 14
2593		[[1,1,1,11+2*k,],[1,2,1,10+2*k,],[1,3,5+k,5+k,],[1,5+k,3,5+k,],[1,5+k,5+k,3,]],
2594		[[1,1,1,11+2*k,],[1,2,4+k,7+k,],[1,6+k,5+k,2,],[2,4+k,2,6+k,],[2,5+k,2,5+k,],[2,5+k,3,4+k,]],
2595		[[1,1,3+k,9+k,],[1,1,4+k,8+k,],[1,3+k,2,8+k,],[2,3+k,2,7+k,],[2,4+k,2,6+k,],[2,5+k,2,5+k,]],
2596		[[1,1,3+k,9+k,],[1,1,7+k,5+k,],[1,3+k,1,9+k,],[1,7+k,2,4+k,],[1,8+k,2,3+k,],[2,5+k,2,5+k,]],
2597		[[1,1,3+k,9+k,],[1,1,8+k,4+k,],[1,3+k,1,9+k,],[1,8+k,2,3+k,],[2,4+k,2,6+k,]],
2598		[[1,1,3+k,9+k,],[1,1,8+k,4+k,],[1,3+k,2,8+k,],[1,4+k,1,8+k,],[2,3+k,2,7+k,],[2,5+k,2,5+k,]],
2599		[[1,1,3+k,9+k,],[1,1,9+k,3+k,],[1,3+k,1,9+k,],[2,3+k,2,7+k,],[2,5+k,2,5+k,]],
2600		[[1,4+k,1,8+k,],[1,4+k,2,7+k,],[1,5+k,3,5+k,],[1,6+k,3,4+k,],[2,5+k,2,5+k,],[2,5+k,3,4+k,]],
2601		[[1,4+k,1,8+k,],[1,4+k,7+k,2,],[1,5+k,3,5+k,],[1,6+k,3,4+k,],[1,6+k,5+k,2,],[2,5+k,2,5+k,]]
2602	];
2603
2604	c:=SCFromDifferenceCycles(dc[i]);
2605	SCRename(c,Concatenation(["L^",String(i),"_",String(2*k)]));
2606
2607	return c;
2608
2609end);
2610
2611
2612################################################################################
2613##<#GAPDoc Label="SCSeriesK">
2614## <ManSection>
2615## <Func Name="SCSeriesK" Arg="i,k"/>
2616## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
2617## <Description>
2618## Generates the <Arg>k</Arg>-th member (<M>k \geq 0</M>) of the series <Arg>K^i</Arg>  (<M>1 \leq i \leq 396</M>) from <Cite Key="Spreer10Diss"/>.  The <M>396</M> series describe a complete classification of all dense series (i. e. there is a member of the series for every integer, <M>f_0 (K^i (k+1) ) = f_0 (K^i (k)) +1</M>) of cyclic <M>3</M>-manifolds with a fixed number of difference cycles and at least one member with less than <M>23</M> vertices. See <Ref Func="SCSeriesL"/> for a list of series of order <M>2</M>.
2619## <Example>
2620## gap> cc:=List([1..10],x->SCSeriesK(x,0));;
2621## gap> Set(List(cc,x->x.F));
2622## gap> cc:=List([1..10],x->SCSeriesK(x,10));;
2623## gap> gap> cc:=List([1..10],x->SCSeriesK(x,10));;
2624## gap> Set(List(cc,x->x.Homology));
2625## gap> Set(List(cc,x->x.IsManifold));
2626## </Example>
2627## </Description>
2628## </ManSection>
2629##<#/GAPDoc>
2630################################################################################
2631InstallGlobalFunction(SCSeriesK,
2632	function(i,k)
2633
2634	local dc,c;
2635
2636	if(not IsInt(k) or not k >= 0 or not i in [1..396]) then
2637		Info(InfoSimpcomp,1,"SCSeriesK: 'i' must be in [1..396], 'k' must be an integer >= 0.");
2638		return fail;
2639	fi;
2640
2641  dc:=[
2642		# n = 9
2643		[[1,1,2,5+k],[1,1,5+k,2],[1,2,1,5+k]],
2644		# n = 11
2645		[[1,1,2,7+k],[1,1,6+k,3],[1,2,2,6+k],[1,3,1,6+k]],
2646		# n = 13
2647		[[1,1,2,9+k],[1,1,7+k,4],[1,2,2,8+k],[1,3,2,7+k],[1,4,1,7+k]],
2648		[[1,1,3,8+k],[1,1,7+k,4],[1,3,1,8+k],[1,7+k,2,3],[2,2,2,7+k]],
2649		[[1,1,4,7+k],[1,1,7+k,4],[1,4,1,7+k],[2,2,2,7+k]],
2650		[[1,2,1,9+k],[1,2,7+k,3],[1,3,7+k,2],[2,2,2,7+k]],
2651		[[1,2,3,7+k],[1,2,8+k,2],[1,3,2,7+k],[1,3,7+k,2],[2,2,2,7+k]],
2652		# n = 15
2653		[[1,1,2,11+k],[1,1,8+k,5],[1,2,2,10+k],[1,3,2,9+k],[1,4,2,8+k],[1,5,1,8+k]],
2654		[[1,1,4,9+k],[1,1,8+k,5],[1,2,2,10+k],[1,2,4,8+k],[1,5,1,8+k],[2,2,8+k,3]],
2655		[[1,1,4,9+k],[1,1,8+k,5],[1,4,2,8+k],[1,5,1,8+k],[2,2,2,9+k]],
2656		[[1,2,2,10+k],[1,2,8+k,4],[1,3,1,10+k],[1,3,8+k,3],[2,2,8+k,3]],
2657		[[1,2,2,10+k],[1,2,9+k,3],[1,3,3,8+k],[1,3,8+k,3],[1,4,2,8+k],[2,2,8+k,3]],
2658		[[1,2,4,8+k],[1,2,8+k,4],[1,3,1,10+k],[1,3,8+k,3],[1,4,2,8+k],[2,2,2,9+k]],
2659		[[1,2,4,8+k],[1,2,8+k,4],[1,4,2,8+k],[1,4,8+k,2],[1,8+k,2,4],[1,8+k,4,2]],
2660		[[1,2,4,8+k],[1,2,9+k,3],[1,3,3,8+k],[1,3,8+k,3],[2,2,2,9+k]],
2661		# n = 17
2662		[[1,1,2,13+k],[1,1,9+k,6],[1,2,2,12+k],[1,3,2,11+k],[1,4,2,10+k],[1,5,2,9+k],[1,6,1,9+k]],
2663		[[1,1,3,12+k],[1,1,9+k,6],[1,3,3,10+k],[1,4,3,9+k],[1,6,1,9+k],[2,3,9+k,3],[2,9+k,3,3]],
2664		[[1,1,4,11+k],[1,1,9+k,6],[1,2,2,12+k],[1,2,4,10+k],[1,5,2,9+k],[1,6,1,9+k],[2,2,10+k,3]],
2665		[[1,1,4,11+k],[1,1,9+k,6],[1,4,2,10+k],[1,5,2,9+k],[1,6,1,9+k],[2,2,2,11+k]],
2666		[[1,1,4,11+k],[1,1,9+k,6],[1,4,3,9+k],[1,5,2,9+k],[1,9+k,5,2],[1,10+k,4,2],[2,2,2,11+k]],
2667		[[1,1,5,10+k],[1,1,9+k,6],[1,5,1,10+k],[1,9+k,2,5],[2,2,2,11+k],[2,4,2,9+k]],
2668		[[1,1,6,9+k],[1,1,9+k,6],[1,6,1,9+k],[2,2,2,11+k],[2,4,2,9+k]],
2669		[[1,1,6,9+k],[1,1,9+k,6],[1,6,1,9+k],[2,3,3,9+k],[2,3,9+k,3],[2,9+k,3,3]],
2670		[[1,2,2,12+k],[1,2,9+k,5],[1,3,2,11+k],[1,3,9+k,4],[1,4,1,11+k],[2,2,9+k,4]],
2671		[[1,2,2,12+k],[1,2,9+k,5],[1,3,4,9+k],[1,3,9+k,4],[1,4,1,11+k],[1,5,2,9+k],[2,2,10+k,3]],
2672		[[1,2,2,12+k],[1,2,10+k,4],[1,3,2,11+k],[1,3,9+k,4],[1,4,3,9+k],[1,5,2,9+k],[2,2,9+k,4]],
2673		[[1,2,2,12+k],[1,2,10+k,4],[1,3,4,9+k],[1,3,9+k,4],[1,4,3,9+k],[2,2,10+k,3]],
2674		[[1,2,2,12+k],[1,2,10+k,4],[1,4,9+k,3],[1,9+k,3,4],[1,9+k,4,3],[2,2,10+k,3]],
2675		[[1,2,3,11+k],[1,2,12+k,2],[1,5,9+k,2],[2,2,2,11+k],[2,4,2,9+k],[2,9+k,3,3]],
2676		[[1,2,4,10+k],[1,2,9+k,5],[1,4,2,10+k],[1,4,10+k,2],[1,9+k,2,5],[1,9+k,5,2],[2,4,2,9+k]],
2677		[[1,2,4,10+k],[1,2,10+k,4],[1,3,4,9+k],[1,3,9+k,4],[1,4,2,10+k],[1,4,3,9+k],[2,2,2,11+k]],
2678		[[1,2,4,10+k],[1,2,10+k,4],[1,4,2,10+k],[1,4,9+k,3],[1,9+k,3,4],[1,9+k,4,3],[2,2,2,11+k]],
2679		[[1,2,4,10+k],[1,2,10+k,4],[1,4,3,9+k],[1,4,10+k,2],[1,6,1,9+k],[1,9+k,5,2],[1,10+k,2,4]],
2680		[[1,2,5,9+k],[1,2,9+k,5],[1,4,1,11+k],[1,4,10+k,2],[1,5,2,9+k],[1,9+k,3,4],[1,9+k,5,2]],
2681		[[1,2,5,9+k],[1,2,9+k,5],[1,5,2,9+k],[1,5,9+k,2],[1,9+k,2,5],[1,9+k,5,2]],
2682		[[1,2,5,9+k],[1,2,10+k,4],[1,4,3,9+k],[1,4,10+k,2],[1,9+k,3,4],[1,9+k,5,2]],
2683		[[1,2,5,9+k],[1,2,12+k,2],[1,5,2,9+k],[1,5,9+k,2],[2,2,2,11+k],[2,3,2,10+k],[2,4,2,9+k]],
2684		[[1,2,9+k,5],[1,2,11+k,3],[1,11+k,2,3],[2,2,2,11+k],[2,3,9+k,3],[2,9+k,3,3]],
2685		[[1,2,10+k,4],[1,2,11+k,3],[1,9+k,3,4],[1,9+k,4,3],[2,2,9+k,4],[2,2,10+k,3],[2,9+k,3,3]],
2686		[[1,3,3,10+k],[1,3,10+k,3],[1,4,2,10+k],[1,4,9+k,3],[2,2,9+k,4],[2,2,10+k,3],[2,9+k,3,3]],
2687		[[2,2,2,11+k],[2,3,3,9+k],[2,3,9+k,3],[2,4,2,9+k],[2,9+k,3,3]],
2688		[[2,2,4,9+k],[2,2,9+k,4],[2,4,2,9+k]],
2689		# n = 19
2690		[[1,1,2,15+k],[1,1,10+k,7],[1,2,2,14+k],[1,3,2,13+k],[1,4,2,12+k],[1,5,2,11+k],[1,6,2,10+k],[1,7,1,10+k]],
2691		[[1,1,3,14+k],[1,1,10+k,7],[1,3,2,13+k],[1,4,3,11+k],[1,5,3,10+k],[1,7,1,10+k],[2,3,10+k,4],[2,10+k,4,3]],
2692		[[1,1,3,14+k],[1,1,10+k,7],[1,3,3,12+k],[1,4,3,11+k],[1,6,2,10+k],[1,7,1,10+k],[2,3,11+k,3],[2,11+k,3,3]],
2693		[[1,1,3,14+k],[1,1,10+k,7],[1,3,5,10+k],[1,4,3,11+k],[1,7,1,10+k],[2,3,11+k,3],[2,10+k,4,3]],
2694		[[1,1,3,14+k],[1,1,11+k,6],[1,3,5,10+k],[1,4,3,11+k],[1,6,1,11+k],[1,6,2,10+k],[2,3,11+k,3],[2,10+k,4,3]],
2695		[[1,1,4,13+k],[1,1,10+k,7],[1,2,2,14+k],[1,2,4,12+k],[1,5,2,11+k],[1,6,2,10+k],[1,7,1,10+k],[2,2,12+k,3]],
2696		[[1,1,4,13+k],[1,1,10+k,7],[1,3,2,13+k],[1,3,4,11+k],[1,4,4,10+k],[1,7,1,10+k],[2,4,10+k,3],[2,10+k,3,4]],
2697		[[1,1,4,13+k],[1,1,10+k,7],[1,4,2,12+k],[1,5,2,11+k],[1,6,2,10+k],[1,7,1,10+k],[2,2,2,13+k]],
2698		[[1,1,4,13+k],[1,1,10+k,7],[1,4,2,12+k],[1,5,3,10+k],[1,6,2,10+k],[1,10+k,6,2],[1,11+k,5,2],[2,2,2,13+k]],
2699		[[1,1,4,13+k],[1,1,11+k,6],[1,4,3,11+k],[1,5,3,10+k],[1,7,1,10+k],[1,10+k,6,2],[1,12+k,4,2],[2,2,2,13+k]],
2700		[[1,1,6,11+k],[1,1,10+k,7],[1,2,2,14+k],[1,2,6,10+k],[1,4,2,12+k],[1,7,1,10+k],[2,2,12+k,3],[2,10+k,3,4]],
2701		[[1,1,6,11+k],[1,1,10+k,7],[1,2,4,12+k],[1,2,5,11+k],[1,10+k,3,5],[1,11+k,2,5],[2,2,2,13+k],[2,10+k,3,4]],
2702		[[1,1,6,11+k],[1,1,10+k,7],[1,2,4,12+k],[1,2,6,10+k],[1,7,1,10+k],[2,2,2,13+k],[2,10+k,3,4]],
2703		[[1,1,6,11+k],[1,1,10+k,7],[1,2,4,12+k],[1,2,6,10+k],[1,7,1,10+k],[2,2,10+k,5],[2,2,12+k,3],[2,4,10+k,3]],
2704		[[1,1,6,11+k],[1,1,10+k,7],[1,3,3,12+k],[1,3,5,10+k],[1,7,1,10+k],[2,3,3,11+k],[2,3,11+k,3],[2,10+k,4,3]],
2705		[[1,1,6,11+k],[1,1,10+k,7],[1,6,2,10+k],[1,7,1,10+k],[2,2,2,13+k],[2,4,2,11+k]],
2706		[[1,1,6,11+k],[1,1,10+k,7],[1,6,2,10+k],[1,7,1,10+k],[2,3,3,11+k],[2,3,11+k,3],[2,11+k,3,3]],
2707		[[1,2,1,15+k],[1,2,5,11+k],[1,3,10+k,5],[1,5,3,10+k],[1,5,11+k,2],[1,7,1,10+k],[1,10+k,5,3],[1,11+k,2,5]],
2708		[[1,2,1,15+k],[1,2,6,10+k],[1,3,10+k,5],[1,5,1,12+k],[1,5,3,10+k],[1,6,10+k,2],[1,10+k,2,6],[1,10+k,5,3]],
2709		[[1,2,1,15+k],[1,2,6,10+k],[1,3,10+k,5],[1,5,3,10+k],[1,5,11+k,2],[1,10+k,3,5],[1,10+k,5,3]],
2710		[[1,2,2,14+k],[1,2,10+k,6],[1,3,2,13+k],[1,3,10+k,5],[1,4,2,12+k],[1,5,1,12+k],[2,2,10+k,5]],
2711		[[1,2,2,14+k],[1,2,10+k,6],[1,3,2,13+k],[1,3,10+k,5],[1,4,4,10+k],[1,5,1,12+k],[1,6,2,10+k],[2,2,11+k,4]],
2712		[[1,2,2,14+k],[1,2,11+k,5],[1,3,2,13+k],[1,3,10+k,5],[1,4,2,12+k],[1,5,3,10+k],[1,6,2,10+k],[2,2,10+k,5]],
2713		[[1,2,2,14+k],[1,2,11+k,5],[1,3,2,13+k],[1,3,10+k,5],[1,4,4,10+k],[1,5,3,10+k],[2,2,11+k,4]],
2714		[[1,2,2,14+k],[1,2,11+k,5],[1,3,4,11+k],[1,3,10+k,5],[1,4,4,10+k],[1,5,2,11+k],[1,5,3,10+k],[2,2,12+k,3]],
2715		[[1,2,4,12+k],[1,2,10+k,6],[1,3,2,13+k],[1,3,10+k,5],[1,5,1,12+k],[2,4,10+k,3],[2,10+k,3,4]],
2716		[[1,2,4,12+k],[1,2,10+k,6],[1,4,2,12+k],[1,4,12+k,2],[1,10+k,2,6],[1,10+k,6,2],[2,4,2,11+k],[2,5,2,10+k]],
2717		[[1,2,4,12+k],[1,2,10+k,6],[1,4,2,12+k],[1,4,12+k,2],[1,12+k,4,2],[2,4,3,10+k],[2,5,2,10+k]],
2718		[[1,2,4,12+k],[1,2,10+k,6],[1,4,3,11+k],[1,4,12+k,2],[1,6,1,11+k],[1,11+k,5,2],[2,4,3,10+k],[2,5,2,10+k]],
2719		[[1,2,4,12+k],[1,2,10+k,6],[1,5,1,12+k],[1,5,11+k,2],[1,10+k,3,5],[1,10+k,6,2],[2,4,2,11+k],[2,10+k,3,4]],
2720		[[1,2,4,12+k],[1,2,10+k,6],[1,6,10+k,2],[1,10+k,2,6],[1,10+k,6,2],[2,4,2,11+k],[2,10+k,3,4]],
2721		[[1,2,4,12+k],[1,2,10+k,6],[1,6,10+k,2],[1,12+k,4,2],[2,4,3,10+k],[2,10+k,3,4]],
2722		[[1,2,4,12+k],[1,2,11+k,5],[1,3,2,13+k],[1,3,10+k,5],[1,5,3,10+k],[1,6,2,10+k],[2,4,10+k,3],[2,10+k,3,4]],
2723		[[1,2,4,12+k],[1,2,11+k,5],[1,6,10+k,2],[1,11+k,2,5],[1,11+k,5,2],[2,4,2,11+k],[2,5,2,10+k],[2,10+k,3,4]],
2724		[[1,2,4,12+k],[1,2,12+k,4],[1,4,2,12+k],[1,4,10+k,4],[2,3,4,10+k],[2,3,10+k,4],[2,4,3,10+k]],
2725		[[1,2,4,12+k],[1,2,14+k,2],[1,6,10+k,2],[2,3,10+k,4],[2,4,3,10+k],[2,10+k,3,4],[2,10+k,4,3]],
2726		[[1,2,5,11+k],[1,2,10+k,6],[1,5,2,11+k],[1,5,11+k,2],[1,10+k,2,6],[1,10+k,6,2],[2,5,2,10+k]],
2727		[[1,2,5,11+k],[1,2,11+k,5],[1,4,1,13+k],[1,4,12+k,2],[1,5,3,10+k],[1,7,1,10+k],[1,10+k,6,2],[1,11+k,3,4]],
2728		[[1,2,5,11+k],[1,2,11+k,5],[1,5,3,10+k],[1,5,11+k,2],[1,7,1,10+k],[1,10+k,6,2],[1,11+k,2,5]],
2729		[[1,2,5,11+k],[1,2,12+k,4],[1,5,2,11+k],[1,5,11+k,2],[1,10+k,2,6],[1,10+k,6,2],[1,12+k,2,4],[2,4,3,10+k]],
2730		[[1,2,6,10+k],[1,2,10+k,6],[1,3,2,13+k],[1,3,10+k,5],[1,5,1,12+k],[1,6,2,10+k],[2,4,2,11+k],[2,4,10+k,3]],
2731		[[1,2,6,10+k],[1,2,10+k,6],[1,5,1,12+k],[1,5,11+k,2],[1,6,2,10+k],[1,10+k,3,5],[1,10+k,6,2]],
2732		[[1,2,6,10+k],[1,2,10+k,6],[1,6,2,10+k],[1,6,10+k,2],[1,10+k,2,6],[1,10+k,6,2]],
2733		[[1,2,6,10+k],[1,2,11+k,5],[1,3,2,13+k],[1,3,10+k,5],[1,5,3,10+k],[2,4,2,11+k],[2,4,10+k,3]],
2734		[[1,2,6,10+k],[1,2,11+k,5],[1,5,3,10+k],[1,5,11+k,2],[1,10+k,3,5],[1,10+k,6,2]],
2735		[[1,2,6,10+k],[1,2,14+k,2],[1,6,2,10+k],[1,6,10+k,2],[2,3,10+k,4],[2,4,2,11+k],[2,4,3,10+k],[2,10+k,4,3]],
2736		[[1,2,11+k,5],[1,2,13+k,3],[1,10+k,3,5],[1,10+k,5,3],[2,2,2,13+k],[2,4,10+k,3],[2,11+k,3,3]],
2737		[[1,2,11+k,5],[1,2,13+k,3],[1,10+k,3,5],[1,10+k,5,3],[2,2,10+k,5],[2,2,12+k,3],[2,10+k,3,4],[2,11+k,3,3]],
2738		[[1,3,1,14+k],[1,3,2,13+k],[1,4,10+k,4],[1,5,10+k,3],[2,2,2,13+k],[2,4,10+k,3]],
2739		[[1,3,1,14+k],[1,3,2,13+k],[1,4,10+k,4],[1,5,10+k,3],[2,2,10+k,5],[2,2,12+k,3],[2,10+k,3,4]],
2740		[[1,3,1,14+k],[1,3,4,11+k],[1,4,10+k,4],[1,5,2,11+k],[1,5,10+k,3],[2,2,10+k,5],[2,2,11+k,4],[2,10+k,3,4]],
2741		[[1,3,1,14+k],[1,3,12+k,3],[1,4,10+k,4],[2,2,2,13+k],[2,3,4,10+k],[2,3,10+k,4],[2,4,3,10+k]],
2742		[[1,3,1,14+k],[1,3,12+k,3],[1,4,10+k,4],[2,2,3,12+k],[2,2,5,10+k],[2,3,4,10+k]],
2743		[[1,3,2,13+k],[1,3,5,10+k],[1,4,4,10+k],[1,4,11+k,3],[1,5,10+k,3],[2,2,2,13+k],[2,4,10+k,3]],
2744		[[1,3,2,13+k],[1,3,5,10+k],[1,4,4,10+k],[1,4,11+k,3],[1,5,10+k,3],[2,2,10+k,5],[2,2,12+k,3],[2,10+k,3,4]],
2745		[[1,3,2,13+k],[1,3,10+k,5],[1,5,10+k,3],[1,10+k,3,5],[1,10+k,5,3],[2,3,10+k,4],[2,3,11+k,3]],
2746		[[1,3,2,13+k],[1,3,10+k,5],[1,5,10+k,3],[1,13+k,2,3],[2,3,10+k,4],[2,4,10+k,3]],
2747		[[1,3,2,13+k],[1,3,11+k,4],[1,4,3,11+k],[1,4,10+k,4],[1,5,2,11+k],[2,2,10+k,5],[2,2,11+k,4],[2,10+k,4,3]],
2748		[[1,3,2,13+k],[1,3,11+k,4],[1,5,10+k,3],[1,10+k,4,4],[1,10+k,5,3],[2,2,2,13+k],[2,4,10+k,3]],
2749		[[1,3,2,13+k],[1,3,11+k,4],[1,5,10+k,3],[1,10+k,4,4],[1,10+k,5,3],[2,2,10+k,5],[2,2,12+k,3],[2,10+k,3,4]],
2750		[[1,3,2,13+k],[1,3,12+k,3],[1,5,10+k,3],[2,3,4,10+k],[2,3,10+k,4],[2,4,3,10+k],[2,4,10+k,3]],
2751		[[1,3,3,12+k],[1,3,12+k,3],[1,4,4,10+k],[1,4,11+k,3],[1,6,2,10+k],[2,2,10+k,5],[2,2,12+k,3],[2,11+k,3,3]],
2752		[[1,3,4,11+k],[1,3,11+k,4],[1,4,3,11+k],[1,4,10+k,4],[2,2,2,13+k],[2,3,4,10+k],[2,3,10+k,4],[2,4,3,10+k]],
2753		[[1,3,4,11+k],[1,3,11+k,4],[1,4,3,11+k],[1,4,10+k,4],[2,2,2,13+k],[2,4,10+k,3],[2,10+k,3,4],[2,10+k,4,3]],
2754		[[1,3,4,11+k],[1,3,11+k,4],[1,4,3,11+k],[1,4,10+k,4],[2,2,3,12+k],[2,2,5,10+k],[2,3,4,10+k]],
2755		[[1,3,4,11+k],[1,3,11+k,4],[1,4,3,11+k],[1,4,10+k,4],[2,2,10+k,5],[2,2,12+k,3],[2,10+k,4,3]],
2756		[[1,3,5,10+k],[1,3,10+k,5],[1,5,3,10+k],[1,5,10+k,3],[1,10+k,3,5],[1,10+k,5,3]],
2757		[[1,3,5,10+k],[1,3,12+k,3],[1,4,2,12+k],[1,4,11+k,3],[1,6,2,10+k],[2,2,11+k,4],[2,2,12+k,3],[2,10+k,4,3]],
2758		[[1,3,5,10+k],[1,3,12+k,3],[1,4,4,10+k],[1,4,11+k,3],[2,2,2,13+k],[2,3,4,10+k],[2,3,10+k,4],[2,4,3,10+k]],
2759		[[1,3,5,10+k],[1,3,12+k,3],[1,4,4,10+k],[1,4,11+k,3],[2,2,2,13+k],[2,4,10+k,3],[2,10+k,3,4],[2,10+k,4,3]],
2760		[[1,3,5,10+k],[1,3,12+k,3],[1,4,4,10+k],[1,4,11+k,3],[2,2,3,12+k],[2,2,5,10+k],[2,3,4,10+k]],
2761		[[1,3,5,10+k],[1,3,12+k,3],[1,4,4,10+k],[1,4,11+k,3],[2,2,10+k,5],[2,2,12+k,3],[2,10+k,4,3]],
2762		[[1,3,5,10+k],[1,3,12+k,3],[1,5,3,10+k],[1,5,10+k,3],[2,3,4,10+k],[2,3,11+k,3],[2,4,3,10+k],[2,4,10+k,3]],
2763		[[2,3,4,10+k],[2,3,10+k,4],[2,4,3,10+k],[2,4,10+k,3],[2,10+k,3,4],[2,10+k,4,3]],
2764		# n = 21
2765		[[1,1,2,17+k],[1,1,11+k,8],[1,2,2,16+k],[1,3,2,15+k],[1,4,2,14+k],[1,5,2,13+k],[1,6,2,12+k],[1,7,2,11+k],[1,8,1,11+k]],
2766		[[1,1,3,16+k],[1,1,11+k,8],[1,3,2,15+k],[1,4,2,14+k],[1,5,3,12+k],[1,6,3,11+k],[1,8,1,11+k],[2,3,11+k,5],[2,11+k,5,3]],
2767		[[1,1,3,16+k],[1,1,11+k,8],[1,3,2,15+k],[1,4,3,13+k],[1,5,3,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,3,12+k,4],[2,12+k,4,3]],
2768		[[1,1,3,16+k],[1,1,11+k,8],[1,3,2,15+k],[1,4,5,11+k],[1,5,3,12+k],[1,8,1,11+k],[2,3,12+k,4],[2,11+k,5,3]],
2769		[[1,1,3,16+k],[1,1,11+k,8],[1,3,3,14+k],[1,4,3,13+k],[1,6,2,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,3,13+k,3],[2,13+k,3,3]],
2770		[[1,1,3,16+k],[1,1,11+k,8],[1,3,5,12+k],[1,4,3,13+k],[1,7,2,11+k],[1,8,1,11+k],[2,3,13+k,3],[2,12+k,4,3]],
2771		[[1,1,3,16+k],[1,1,11+k,8],[1,3,5,12+k],[1,4,5,11+k],[1,8,1,11+k],[2,3,2,14+k],[2,5,11+k,3],[2,11+k,3,5]],
2772		[[1,1,3,16+k],[1,1,11+k,8],[1,3,5,12+k],[1,4,5,11+k],[1,8,1,11+k],[2,3,13+k,3],[2,11+k,5,3]],
2773		[[1,1,3,16+k],[1,1,11+k,8],[1,3,6,11+k],[1,4,3,13+k],[1,7,2,11+k],[1,11+k,4,5],[1,12+k,3,5],[2,3,13+k,3],[2,12+k,4,3]],
2774		[[1,1,3,16+k],[1,1,11+k,8],[1,3,6,11+k],[1,4,5,11+k],[1,11+k,4,5],[1,12+k,3,5],[2,3,2,14+k],[2,5,11+k,3],[2,11+k,3,5]],
2775		[[1,1,3,16+k],[1,1,11+k,8],[1,3,6,11+k],[1,4,5,11+k],[1,11+k,4,5],[1,12+k,3,5],[2,3,13+k,3],[2,11+k,5,3]],
2776		[[1,1,3,16+k],[1,1,12+k,7],[1,3,2,15+k],[1,4,5,11+k],[1,5,3,12+k],[1,7,1,12+k],[1,7,2,11+k],[2,3,12+k,4],[2,11+k,5,3]],
2777		[[1,1,3,16+k],[1,1,12+k,7],[1,3,5,12+k],[1,4,5,11+k],[1,7,1,12+k],[1,7,2,11+k],[2,3,13+k,3],[2,11+k,5,3]],
2778		[[1,1,3,16+k],[1,1,13+k,6],[1,3,5,12+k],[1,4,5,11+k],[1,6,1,13+k],[1,6,2,12+k],[1,7,2,11+k],[2,3,13+k,3],[2,11+k,5,3]],
2779		[[1,1,3,16+k],[1,1,14+k,5],[1,3,5,12+k],[1,4,5,11+k],[1,8,1,11+k],[1,11+k,3,6],[1,12+k,3,5],[2,3,2,14+k],[2,5,11+k,3]],
2780		[[1,1,3,16+k],[1,1,14+k,5],[1,3,6,11+k],[1,4,5,11+k],[1,11+k,3,6],[1,11+k,4,5],[2,3,2,14+k],[2,5,11+k,3]],
2781		[[1,1,3,16+k],[1,1,14+k,5],[1,3,6,11+k],[1,4,5,11+k],[1,11+k,3,6],[1,11+k,4,5],[2,3,13+k,3],[2,11+k,3,5],[2,11+k,5,3]],
2782		[[1,1,4,15+k],[1,1,11+k,8],[1,2,2,16+k],[1,2,4,14+k],[1,5,2,13+k],[1,6,2,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,2,14+k,3]],
2783		[[1,1,4,15+k],[1,1,11+k,8],[1,3,2,15+k],[1,3,4,13+k],[1,4,4,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,4,12+k,3],[2,12+k,3,4]],
2784		[[1,1,4,15+k],[1,1,11+k,8],[1,3,2,15+k],[1,3,6,11+k],[1,4,4,12+k],[1,8,1,11+k],[2,4,12+k,3],[2,11+k,4,4]],
2785		[[1,1,4,15+k],[1,1,11+k,8],[1,4,2,14+k],[1,5,2,13+k],[1,6,2,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,2,2,15+k]],
2786		[[1,1,4,15+k],[1,1,11+k,8],[1,4,2,14+k],[1,5,2,13+k],[1,6,3,11+k],[1,7,2,11+k],[1,11+k,7,2],[1,12+k,6,2],[2,2,2,15+k]],
2787		[[1,1,4,15+k],[1,1,11+k,8],[1,4,3,13+k],[1,5,3,12+k],[1,7,1,12+k],[1,11+k,6,3],[1,13+k,4,3],[2,4,11+k,4],[2,11+k,4,4]],
2788		[[1,1,4,15+k],[1,1,11+k,8],[1,4,4,12+k],[1,5,3,12+k],[1,11+k,6,3],[1,12+k,5,3],[2,4,11+k,4],[2,11+k,4,4]],
2789		[[1,1,4,15+k],[1,1,11+k,8],[1,4,4,12+k],[1,5,4,11+k],[1,8,1,11+k],[2,4,11+k,4],[2,11+k,4,4]],
2790		[[1,1,4,15+k],[1,1,12+k,7],[1,3,2,15+k],[1,3,6,11+k],[1,4,4,12+k],[1,7,1,12+k],[1,7,2,11+k],[2,4,12+k,3],[2,11+k,4,4]],
2791		[[1,1,4,15+k],[1,1,12+k,7],[1,3,4,13+k],[1,3,6,11+k],[1,4,4,12+k],[1,5,4,11+k],[1,7,1,12+k],[2,4,11+k,4],[2,12+k,3,4]],
2792		[[1,1,4,15+k],[1,1,12+k,7],[1,4,2,14+k],[1,5,3,12+k],[1,6,3,11+k],[1,8,1,11+k],[1,11+k,7,2],[1,13+k,5,2],[2,2,2,15+k]],
2793		[[1,1,4,15+k],[1,1,12+k,7],[1,4,3,13+k],[1,5,4,11+k],[1,7,2,11+k],[1,12+k,5,3],[1,13+k,4,3],[2,4,11+k,4],[2,11+k,4,4]],
2794		[[1,1,4,15+k],[1,1,12+k,7],[1,4,4,12+k],[1,5,4,11+k],[1,7,1,12+k],[1,7,2,11+k],[2,4,11+k,4],[2,11+k,4,4]],
2795		[[1,1,4,15+k],[1,1,15+k,4],[1,4,1,15+k],[2,4,11+k,4],[3,3,4,11+k],[3,3,11+k,4],[3,4,3,11+k]],
2796		[[1,1,5,14+k],[1,1,11+k,8],[1,3,2,15+k],[1,3,5,12+k],[1,4,2,14+k],[1,4,5,11+k],[1,8,1,11+k],[2,5,11+k,3],[2,11+k,3,5]],
2797		[[1,1,5,14+k],[1,1,11+k,8],[1,4,2,14+k],[1,4,5,11+k],[1,5,3,12+k],[1,8,1,11+k],[2,3,2,14+k],[2,3,12+k,4],[2,11+k,5,3]],
2798		[[1,1,5,14+k],[1,1,11+k,8],[1,5,3,12+k],[1,6,3,11+k],[1,8,1,11+k],[2,3,2,14+k],[2,3,11+k,5],[2,11+k,5,3]],
2799		[[1,1,5,14+k],[1,1,11+k,8],[1,5,4,11+k],[1,6,3,11+k],[1,11+k,6,3],[1,12+k,5,3],[2,3,2,14+k],[2,3,11+k,5],[2,11+k,5,3]],
2800		[[1,1,6,13+k],[1,1,11+k,8],[1,2,2,16+k],[1,2,6,12+k],[1,4,2,14+k],[1,7,2,11+k],[1,8,1,11+k],[2,2,14+k,3],[2,12+k,3,4]],
2801		[[1,1,6,13+k],[1,1,11+k,8],[1,2,4,14+k],[1,2,6,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,2,2,15+k],[2,12+k,3,4]],
2802		[[1,1,6,13+k],[1,1,11+k,8],[1,2,4,14+k],[1,2,6,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,2,12+k,5],[2,2,14+k,3],[2,4,12+k,3]],
2803		[[1,1,6,13+k],[1,1,11+k,8],[1,3,3,14+k],[1,3,5,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,3,3,13+k],[2,3,13+k,3],[2,12+k,4,3]],
2804		[[1,1,6,13+k],[1,1,11+k,8],[1,6,1,13+k],[1,11+k,2,7],[1,12+k,2,6],[2,3,5,11+k],[2,3,13+k,3],[2,11+k,5,3]],
2805		[[1,1,6,13+k],[1,1,11+k,8],[1,6,1,13+k],[1,11+k,5,4],[1,12+k,2,6],[1,13+k,3,4],[2,3,4,12+k],[2,3,13+k,3],[2,11+k,5,3]],
2806		[[1,1,6,13+k],[1,1,11+k,8],[1,6,2,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,2,2,15+k],[2,4,2,13+k]],
2807		[[1,1,6,13+k],[1,1,11+k,8],[1,6,2,12+k],[1,7,2,11+k],[1,8,1,11+k],[2,3,3,13+k],[2,3,13+k,3],[2,13+k,3,3]],
2808		[[1,1,6,13+k],[1,1,11+k,8],[1,6,3,11+k],[1,7,2,11+k],[1,11+k,7,2],[1,12+k,6,2],[2,2,2,15+k],[2,4,2,13+k]],
2809		[[1,1,6,13+k],[1,1,12+k,7],[1,6,2,12+k],[1,7,1,12+k],[2,3,5,11+k],[2,3,13+k,3],[2,6,2,11+k],[2,11+k,5,3]],
2810		[[1,1,6,13+k],[1,1,13+k,6],[1,6,1,13+k],[2,3,5,11+k],[2,3,13+k,3],[2,6,2,11+k],[2,11+k,5,3]],
2811		[[1,1,7,12+k],[1,1,11+k,8],[1,4,3,13+k],[1,4,4,12+k],[1,11+k,6,3],[1,12+k,5,3],[2,4,3,12+k],[2,4,11+k,4],[2,11+k,4,4]],
2812		[[1,1,7,12+k],[1,1,11+k,8],[1,7,1,12+k],[1,11+k,2,7],[2,2,2,15+k],[2,4,2,13+k],[2,6,2,11+k]],
2813		[[1,1,7,12+k],[1,1,11+k,8],[1,7,1,12+k],[1,11+k,2,7],[2,3,3,13+k],[2,3,13+k,3],[2,6,2,11+k],[2,13+k,3,3]],
2814		[[1,1,7,12+k],[1,1,11+k,8],[1,7,1,12+k],[1,11+k,2,7],[2,3,5,11+k],[2,3,13+k,3],[2,11+k,5,3]],
2815		[[1,1,7,12+k],[1,1,11+k,8],[1,7,1,12+k],[1,11+k,2,7],[2,4,4,11+k],[2,4,11+k,4],[2,11+k,4,4]],
2816		[[1,1,7,12+k],[1,1,11+k,8],[1,7,1,12+k],[1,11+k,4,5],[1,13+k,4,3],[1,15+k,2,3],[2,3,12+k,4],[2,4,3,12+k],[2,11+k,4,4]],
2817		[[1,1,7,12+k],[1,1,11+k,8],[1,7,1,12+k],[1,11+k,5,4],[1,13+k,3,4],[2,3,4,12+k],[2,3,13+k,3],[2,11+k,5,3]],
2818		[[1,1,7,12+k],[1,1,11+k,8],[1,7,1,12+k],[1,11+k,6,3],[1,13+k,4,3],[2,4,3,12+k],[2,4,11+k,4],[2,11+k,4,4]],
2819		[[1,1,8,11+k],[1,1,11+k,8],[1,8,1,11+k],[2,2,2,15+k],[2,4,2,13+k],[2,6,2,11+k]],
2820		[[1,1,8,11+k],[1,1,11+k,8],[1,8,1,11+k],[2,3,2,14+k],[2,3,5,11+k],[2,5,11+k,3],[2,11+k,3,5]],
2821		[[1,1,8,11+k],[1,1,11+k,8],[1,8,1,11+k],[2,3,3,13+k],[2,3,13+k,3],[2,6,2,11+k],[2,13+k,3,3]],
2822		[[1,1,8,11+k],[1,1,11+k,8],[1,8,1,11+k],[2,3,5,11+k],[2,3,13+k,3],[2,11+k,5,3]],
2823		[[1,1,8,11+k],[1,1,11+k,8],[1,8,1,11+k],[2,4,4,11+k],[2,4,11+k,4],[2,11+k,4,4]],
2824		[[1,2,1,17+k],[1,2,5,13+k],[1,3,12+k,5],[1,5,4,11+k],[1,5,13+k,2],[1,7,1,12+k],[1,8,1,11+k],[1,11+k,6,3],[1,13+k,2,5]],
2825		[[1,2,1,17+k],[1,2,6,12+k],[1,3,11+k,6],[1,5,1,14+k],[1,5,13+k,2],[1,6,3,11+k],[1,8,1,11+k],[1,11+k,6,3],[1,12+k,3,5]],
2826		[[1,2,1,17+k],[1,2,6,12+k],[1,3,11+k,6],[1,5,3,12+k],[1,5,4,11+k],[1,6,3,11+k],[1,6,12+k,2],[1,12+k,2,6],[1,12+k,5,3]],
2827		[[1,2,1,17+k],[1,2,6,12+k],[1,3,11+k,6],[1,6,3,11+k],[1,6,12+k,2],[1,8,1,11+k],[1,11+k,6,3],[1,12+k,2,6]],
2828		[[1,2,1,17+k],[1,2,6,12+k],[1,3,12+k,5],[1,5,1,14+k],[1,5,4,11+k],[1,6,12+k,2],[1,8,1,11+k],[1,11+k,6,3],[1,12+k,2,6]],
2829		[[1,2,1,17+k],[1,2,6,12+k],[1,3,12+k,5],[1,5,4,11+k],[1,5,13+k,2],[1,8,1,11+k],[1,11+k,6,3],[1,12+k,3,5]],
2830		[[1,2,1,17+k],[1,2,7,11+k],[1,3,11+k,6],[1,6,1,13+k],[1,6,3,11+k],[1,7,11+k,2],[1,11+k,2,7],[1,11+k,6,3]],
2831		[[1,2,1,17+k],[1,2,7,11+k],[1,3,11+k,6],[1,6,3,11+k],[1,6,12+k,2],[1,11+k,3,6],[1,11+k,6,3]],
2832		[[1,2,1,17+k],[1,2,7,11+k],[1,3,12+k,5],[1,5,1,14+k],[1,5,3,12+k],[1,6,12+k,2],[1,8,1,11+k],[1,11+k,3,6],[1,12+k,5,3]],
2833		[[1,2,1,17+k],[1,2,7,11+k],[1,3,12+k,5],[1,5,1,14+k],[1,5,4,11+k],[1,6,1,13+k],[1,7,11+k,2],[1,11+k,2,7],[1,11+k,6,3]],
2834		[[1,2,1,17+k],[1,2,7,11+k],[1,3,12+k,5],[1,5,1,14+k],[1,5,4,11+k],[1,6,12+k,2],[1,11+k,3,6],[1,11+k,6,3]],
2835		[[1,2,1,17+k],[1,2,7,11+k],[1,3,12+k,5],[1,5,4,11+k],[1,5,13+k,2],[1,11+k,3,6],[1,11+k,6,3],[1,12+k,2,6],[1,12+k,3,5]],
2836		[[1,2,2,16+k],[1,2,11+k,7],[1,3,2,15+k],[1,3,11+k,6],[1,4,2,14+k],[1,5,2,13+k],[1,6,1,13+k],[2,2,11+k,6]],
2837		[[1,2,2,16+k],[1,2,11+k,7],[1,3,2,15+k],[1,3,11+k,6],[1,4,2,14+k],[1,5,4,11+k],[1,6,1,13+k],[1,7,2,11+k],[2,2,12+k,5]],
2838		[[1,2,2,16+k],[1,2,11+k,7],[1,4,1,15+k],[1,5,11+k,4],[1,11+k,2,7],[1,11+k,4,5],[2,2,5,12+k],[2,5,3,11+k],[2,11+k,5,3]],
2839		[[1,2,2,16+k],[1,2,11+k,7],[1,4,1,15+k],[1,5,11+k,4],[1,13+k,2,5],[2,2,6,11+k],[2,5,3,11+k],[2,11+k,5,3]],
2840		[[1,2,2,16+k],[1,2,11+k,7],[1,4,2,14+k],[1,6,11+k,3],[1,13+k,4,3],[2,2,14+k,3],[2,11+k,4,4],[3,4,3,11+k]],
2841		[[1,2,2,16+k],[1,2,11+k,7],[1,4,12+k,4],[1,11+k,2,7],[1,11+k,5,4],[2,2,5,12+k],[2,5,3,11+k],[2,11+k,5,3]],
2842		[[1,2,2,16+k],[1,2,11+k,7],[1,4,12+k,4],[1,11+k,4,5],[1,11+k,5,4],[1,13+k,2,5],[2,2,6,11+k],[2,5,3,11+k],[2,11+k,5,3]],
2843		[[1,2,2,16+k],[1,2,11+k,7],[1,4,13+k,3],[1,13+k,4,3],[2,2,11+k,6],[2,13+k,3,3],[3,3,4,11+k],[3,4,3,11+k]],
2844		[[1,2,2,16+k],[1,2,11+k,7],[1,4,13+k,3],[1,13+k,4,3],[2,2,14+k,3],[2,11+k,3,5],[3,4,3,11+k]],
2845		[[1,2,2,16+k],[1,2,12+k,6],[1,3,2,15+k],[1,3,11+k,6],[1,4,2,14+k],[1,5,2,13+k],[1,6,3,11+k],[1,7,2,11+k],[2,2,11+k,6]],
2846		[[1,2,2,16+k],[1,2,12+k,6],[1,3,2,15+k],[1,3,11+k,6],[1,4,2,14+k],[1,5,4,11+k],[1,6,3,11+k],[2,2,12+k,5]],
2847		[[1,2,2,16+k],[1,2,12+k,6],[1,3,2,15+k],[1,3,11+k,6],[1,4,4,12+k],[1,5,4,11+k],[1,6,2,12+k],[1,6,3,11+k],[2,2,13+k,4]],
2848		[[1,2,2,16+k],[1,2,13+k,5],[1,4,1,15+k],[1,5,11+k,4],[2,2,6,11+k],[2,6,2,11+k],[2,11+k,5,3]],
2849		[[1,2,2,16+k],[1,2,13+k,5],[1,4,1,15+k],[1,5,11+k,4],[2,2,13+k,4],[2,11+k,4,4],[2,11+k,5,3]],
2850		[[1,2,2,16+k],[1,2,13+k,5],[1,4,12+k,4],[1,11+k,2,7],[1,11+k,5,4],[1,13+k,2,5],[2,2,5,12+k],[2,6,2,11+k],[2,11+k,5,3]],
2851		[[1,2,2,16+k],[1,2,13+k,5],[1,4,12+k,4],[1,11+k,4,5],[1,11+k,5,4],[2,2,6,11+k],[2,6,2,11+k],[2,11+k,5,3]],
2852		[[1,2,2,16+k],[1,2,13+k,5],[1,4,12+k,4],[1,11+k,4,5],[1,11+k,5,4],[2,2,13+k,4],[2,11+k,4,4],[2,11+k,5,3]],
2853		[[1,2,2,16+k],[1,2,14+k,4],[1,4,3,13+k],[1,5,2,13+k],[1,5,11+k,4],[2,2,6,11+k],[2,6,2,11+k],[2,11+k,5,3]],
2854		[[1,2,2,16+k],[1,2,14+k,4],[1,4,3,13+k],[1,5,2,13+k],[1,5,11+k,4],[2,2,13+k,4],[2,11+k,4,4],[2,11+k,5,3]],
2855		[[1,2,2,16+k],[1,2,14+k,4],[1,4,5,11+k],[1,5,2,13+k],[1,5,11+k,4],[1,7,2,11+k],[2,2,6,11+k],[2,6,2,11+k],[2,12+k,4,3]],
2856		[[1,2,2,16+k],[1,2,14+k,4],[1,4,5,11+k],[1,5,2,13+k],[1,5,11+k,4],[1,7,2,11+k],[2,2,13+k,4],[2,11+k,4,4],[2,12+k,4,3]],
2857		[[1,2,2,16+k],[1,2,15+k,3],[1,4,2,14+k],[1,6,11+k,3],[2,2,14+k,3],[3,3,11+k,4],[3,4,3,11+k]],
2858		[[1,2,2,16+k],[1,2,15+k,3],[1,4,13+k,3],[2,2,14+k,3],[2,11+k,3,5],[2,11+k,4,4],[3,3,11+k,4],[3,4,3,11+k]],
2859		[[1,2,3,15+k],[1,2,7,11+k],[1,4,5,11+k],[1,4,12+k,4],[1,5,11+k,4],[2,3,4,12+k],[3,3,11+k,4],[3,4,3,11+k]],
2860		[[1,2,3,15+k],[1,2,11+k,7],[1,4,1,15+k],[1,4,11+k,5],[1,13+k,3,4],[2,3,11+k,5],[2,11+k,3,5],[3,3,4,11+k]],
2861		[[1,2,3,15+k],[1,2,11+k,7],[1,4,5,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,13+k,3,4],[2,3,11+k,5],[2,11+k,3,5],[3,3,4,11+k]],
2862		[[1,2,3,15+k],[1,2,13+k,5],[1,4,3,13+k],[1,4,11+k,5],[1,5,2,13+k],[2,3,11+k,5],[3,3,4,11+k],[3,4,3,11+k]],
2863		[[1,2,3,15+k],[1,2,14+k,4],[1,4,1,15+k],[1,4,11+k,5],[2,3,11+k,5],[3,3,4,11+k],[3,4,3,11+k]],
2864		[[1,2,3,15+k],[1,2,14+k,4],[1,4,5,11+k],[1,4,12+k,4],[1,5,4,11+k],[2,3,11+k,5],[3,3,4,11+k],[3,4,3,11+k]],
2865		[[1,2,4,14+k],[1,2,11+k,7],[1,3,2,15+k],[1,3,11+k,6],[1,5,4,11+k],[1,6,1,13+k],[1,7,2,11+k],[2,4,12+k,3],[2,12+k,3,4]],
2866		[[1,2,4,14+k],[1,2,11+k,7],[1,3,4,13+k],[1,3,11+k,6],[1,6,1,13+k],[2,4,11+k,4],[2,11+k,4,4]],
2867		[[1,2,4,14+k],[1,2,11+k,7],[1,3,6,11+k],[1,3,11+k,6],[1,6,1,13+k],[1,7,2,11+k],[2,4,11+k,4],[2,12+k,3,4]],
2868		[[1,2,4,14+k],[1,2,11+k,7],[1,4,2,14+k],[1,4,13+k,3],[1,13+k,4,3],[2,2,2,15+k],[2,11+k,3,5],[3,4,3,11+k]],
2869		[[1,2,4,14+k],[1,2,11+k,7],[1,4,2,14+k],[1,4,14+k,2],[1,11+k,2,7],[1,11+k,7,2],[2,4,2,13+k],[2,5,2,12+k],[2,6,2,11+k]],
2870		[[1,2,4,14+k],[1,2,11+k,7],[1,4,2,14+k],[1,4,14+k,2],[1,13+k,5,2],[2,4,2,13+k],[2,5,3,11+k],[2,6,2,11+k]],
2871		[[1,2,4,14+k],[1,2,11+k,7],[1,4,3,13+k],[1,4,14+k,2],[1,6,3,11+k],[1,7,2,11+k],[1,13+k,5,2],[2,4,3,12+k],[2,5,2,12+k]],
2872		[[1,2,4,14+k],[1,2,11+k,7],[1,6,11+k,3],[1,13+k,4,3],[2,2,2,15+k],[2,11+k,4,4],[3,4,3,11+k]],
2873		[[1,2,4,14+k],[1,2,11+k,7],[1,6,12+k,2],[1,11+k,2,7],[1,11+k,7,2],[2,4,2,13+k],[2,6,2,11+k],[2,12+k,3,4]],
2874		[[1,2,4,14+k],[1,2,11+k,7],[1,6,12+k,2],[1,11+k,3,6],[1,11+k,7,2],[1,13+k,3,4],[1,14+k,2,4],[2,5,2,12+k],[2,11+k,3,5]],
2875		[[1,2,4,14+k],[1,2,11+k,7],[1,6,12+k,2],[1,13+k,5,2],[2,4,2,13+k],[2,5,2,12+k],[2,5,3,11+k],[2,6,2,11+k],[2,12+k,3,4]],
2876		[[1,2,4,14+k],[1,2,12+k,6],[1,3,2,15+k],[1,3,11+k,6],[1,5,4,11+k],[1,6,3,11+k],[2,4,12+k,3],[2,12+k,3,4]],
2877		[[1,2,4,14+k],[1,2,12+k,6],[1,3,4,13+k],[1,3,11+k,6],[1,6,3,11+k],[1,7,2,11+k],[2,4,11+k,4],[2,11+k,4,4]],
2878		[[1,2,4,14+k],[1,2,12+k,6],[1,3,4,13+k],[1,3,12+k,5],[1,5,1,14+k],[1,5,4,11+k],[1,7,2,11+k],[2,4,11+k,4],[2,11+k,4,4]],
2879		[[1,2,4,14+k],[1,2,12+k,6],[1,3,6,11+k],[1,3,11+k,6],[1,6,3,11+k],[2,4,11+k,4],[2,12+k,3,4]],
2880		[[1,2,4,14+k],[1,2,12+k,6],[1,3,6,11+k],[1,3,12+k,5],[1,5,1,14+k],[1,5,4,11+k],[2,4,11+k,4],[2,12+k,3,4]],
2881		[[1,2,4,14+k],[1,2,12+k,6],[1,4,3,13+k],[1,4,14+k,2],[1,6,1,13+k],[1,11+k,2,7],[1,11+k,7,2],[2,4,3,12+k],[2,5,3,11+k]],
2882		[[1,2,4,14+k],[1,2,12+k,6],[1,6,1,13+k],[1,7,11+k,2],[1,11+k,2,7],[1,11+k,7,2],[2,4,3,12+k],[3,4,3,11+k]],
2883		[[1,2,4,14+k],[1,2,12+k,6],[1,6,1,13+k],[1,7,11+k,2],[1,13+k,5,2],[2,4,3,12+k],[2,5,2,12+k],[2,5,3,11+k],[3,4,3,11+k]],
2884		[[1,2,4,14+k],[1,2,12+k,6],[1,6,12+k,2],[1,11+k,3,6],[1,11+k,7,2],[2,4,3,12+k],[3,4,3,11+k]],
2885		[[1,2,4,14+k],[1,2,13+k,5],[1,3,6,11+k],[1,3,12+k,5],[1,5,3,12+k],[1,5,4,11+k],[1,6,2,12+k],[2,4,11+k,4],[2,12+k,3,4]],
2886		[[1,2,4,14+k],[1,2,13+k,5],[1,6,12+k,2],[1,11+k,2,7],[1,11+k,7,2],[1,13+k,2,5],[2,4,2,13+k],[2,5,3,11+k],[2,12+k,3,4]],
2887		[[1,2,4,14+k],[1,2,14+k,4],[1,4,5,11+k],[1,4,12+k,4],[1,6,3,11+k],[2,3,4,12+k],[2,3,11+k,5],[2,4,3,12+k]],
2888		[[1,2,4,14+k],[1,2,14+k,4],[1,6,1,13+k],[1,7,11+k,2],[1,11+k,2,7],[1,11+k,7,2],[1,14+k,2,4],[2,5,2,12+k],[3,4,3,11+k]],
2889		[[1,2,4,14+k],[1,2,14+k,4],[1,6,1,13+k],[1,7,11+k,2],[1,13+k,5,2],[1,14+k,2,4],[2,5,3,11+k],[3,4,3,11+k]],
2890		[[1,2,4,14+k],[1,2,14+k,4],[1,6,11+k,3],[1,13+k,3,4],[1,13+k,4,3],[2,2,2,15+k],[2,11+k,3,5],[2,11+k,4,4]],
2891		[[1,2,4,14+k],[1,2,14+k,4],[1,6,12+k,2],[1,11+k,2,7],[1,11+k,3,6],[1,13+k,5,2],[1,14+k,2,4],[2,5,3,11+k],[3,4,3,11+k]],
2892		[[1,2,4,14+k],[1,2,14+k,4],[1,6,12+k,2],[1,11+k,3,6],[1,11+k,7,2],[1,14+k,2,4],[2,5,2,12+k],[3,4,3,11+k]],
2893		[[1,2,4,14+k],[1,2,15+k,3],[1,6,11+k,3],[2,2,2,15+k],[3,3,11+k,4],[3,4,3,11+k]],
2894		[[1,2,5,13+k],[1,2,11+k,7],[1,3,4,13+k],[1,3,11+k,6],[1,13+k,3,4],[1,14+k,2,4],[2,4,11+k,4],[2,11+k,4,4]],
2895		[[1,2,5,13+k],[1,2,11+k,7],[1,3,5,12+k],[1,3,11+k,6],[1,7,1,12+k],[1,12+k,4,4],[1,14+k,2,4],[2,4,11+k,4],[2,11+k,4,4]],
2896		[[1,2,5,13+k],[1,2,11+k,7],[1,3,6,11+k],[1,3,11+k,6],[1,7,2,11+k],[1,13+k,3,4],[1,14+k,2,4],[2,4,11+k,4],[2,12+k,3,4]],
2897		[[1,2,5,13+k],[1,2,11+k,7],[1,4,2,14+k],[1,4,14+k,2],[1,6,1,13+k],[1,11+k,3,6],[1,11+k,7,2],[2,11+k,3,5],[2,12+k,3,4]],
2898		[[1,2,5,13+k],[1,2,11+k,7],[1,4,3,13+k],[1,4,14+k,2],[1,13+k,5,2],[2,11+k,3,5],[3,4,3,11+k]],
2899		[[1,2,5,13+k],[1,2,11+k,7],[1,5,2,13+k],[1,5,13+k,2],[1,11+k,2,7],[1,11+k,7,2],[2,5,2,12+k],[2,6,2,11+k]],
2900		[[1,2,5,13+k],[1,2,11+k,7],[1,5,2,13+k],[1,5,13+k,2],[1,13+k,5,2],[2,5,3,11+k],[2,6,2,11+k]],
2901		[[1,2,5,13+k],[1,2,11+k,7],[1,5,3,12+k],[1,5,13+k,2],[1,7,1,12+k],[1,12+k,6,2],[2,5,3,11+k],[2,6,2,11+k]],
2902		[[1,2,5,13+k],[1,2,11+k,7],[1,6,1,13+k],[1,6,12+k,2],[1,11+k,3,6],[1,11+k,7,2],[2,5,2,12+k],[2,11+k,3,5]],
2903		[[1,2,5,13+k],[1,2,11+k,7],[1,7,11+k,2],[1,11+k,2,7],[1,11+k,7,2],[2,5,2,12+k],[2,11+k,3,5]],
2904		[[1,2,5,13+k],[1,2,11+k,7],[1,7,11+k,2],[1,13+k,5,2],[2,5,3,11+k],[2,11+k,3,5]],
2905		[[1,2,5,13+k],[1,2,12+k,6],[1,7,11+k,2],[1,11+k,2,7],[1,11+k,7,2],[1,13+k,3,4],[1,14+k,2,4],[2,4,3,12+k],[3,4,3,11+k]],
2906		[[1,2,5,13+k],[1,2,12+k,6],[1,7,11+k,2],[1,12+k,2,6],[1,12+k,6,2],[2,5,2,12+k],[2,6,2,11+k],[2,11+k,3,5]],
2907		[[1,2,5,13+k],[1,2,14+k,4],[1,6,1,13+k],[1,6,12+k,2],[1,11+k,3,6],[1,11+k,7,2],[1,13+k,3,4],[2,5,2,12+k],[3,4,3,11+k]],
2908		[[1,2,5,13+k],[1,2,14+k,4],[1,7,11+k,2],[1,11+k,2,7],[1,11+k,7,2],[1,13+k,3,4],[2,5,2,12+k],[3,4,3,11+k]],
2909		[[1,2,5,13+k],[1,2,14+k,4],[1,7,11+k,2],[1,12+k,2,6],[1,12+k,6,2],[1,14+k,2,4],[2,4,3,12+k],[2,6,2,11+k],[2,11+k,3,5]],
2910		[[1,2,5,13+k],[1,2,15+k,3],[1,4,3,13+k],[1,4,13+k,3],[2,4,4,11+k],[2,4,11+k,4],[2,5,3,11+k],[3,3,11+k,4]],
2911		[[1,2,5,13+k],[1,2,16+k,2],[1,7,11+k,2],[2,2,2,15+k],[2,3,2,14+k],[2,4,2,13+k],[2,6,2,11+k],[2,11+k,3,5]],
2912		[[1,2,5,13+k],[1,2,16+k,2],[1,7,11+k,2],[2,3,2,14+k],[2,4,4,11+k],[2,4,11+k,4],[2,11+k,3,5],[2,11+k,4,4]],
2913		[[1,2,6,12+k],[1,2,7,11+k],[1,3,6,11+k],[1,3,12+k,5],[1,5,1,14+k],[1,5,3,12+k],[1,6,11+k,3],[1,12+k,2,6],[1,12+k,5,3]],
2914		[[1,2,6,12+k],[1,2,11+k,7],[1,6,2,12+k],[1,6,12+k,2],[1,11+k,2,7],[1,11+k,7,2],[2,6,2,11+k]],
2915		[[1,2,6,12+k],[1,2,12+k,6],[1,3,2,15+k],[1,3,11+k,6],[1,5,4,11+k],[1,6,2,12+k],[1,6,3,11+k],[2,4,2,13+k],[2,4,12+k,3]],
2916		[[1,2,6,12+k],[1,2,12+k,6],[1,3,5,12+k],[1,3,6,11+k],[1,5,1,14+k],[1,5,13+k,2],[1,6,3,11+k],[1,11+k,4,5],[1,11+k,7,2]],
2917		[[1,2,6,12+k],[1,2,12+k,6],[1,3,6,11+k],[1,3,11+k,6],[1,6,2,12+k],[1,6,3,11+k],[2,4,2,13+k],[2,4,11+k,4]],
2918		[[1,2,6,12+k],[1,2,12+k,6],[1,3,6,11+k],[1,3,12+k,5],[1,5,1,14+k],[1,5,4,11+k],[1,6,2,12+k],[2,4,2,13+k],[2,4,11+k,4]],
2919		[[1,2,6,12+k],[1,2,12+k,6],[1,3,11+k,6],[1,3,12+k,5],[1,5,4,11+k],[1,5,13+k,2],[1,8,1,11+k],[1,11+k,7,2],[1,12+k,3,5]],
2920		[[1,2,6,12+k],[1,2,12+k,6],[1,5,1,14+k],[1,5,13+k,2],[1,6,3,11+k],[1,8,1,11+k],[1,11+k,7,2],[1,12+k,3,5]],
2921		[[1,2,6,12+k],[1,2,12+k,6],[1,6,3,11+k],[1,6,12+k,2],[1,8,1,11+k],[1,11+k,7,2],[1,12+k,2,6]],
2922		[[1,2,6,12+k],[1,2,13+k,5],[1,3,6,11+k],[1,3,11+k,6],[1,5,1,14+k],[1,5,3,12+k],[1,6,3,11+k],[2,4,2,13+k],[2,4,11+k,4]],
2923		[[1,2,6,12+k],[1,2,13+k,5],[1,3,6,11+k],[1,3,12+k,5],[1,5,3,12+k],[1,5,4,11+k],[2,4,2,13+k],[2,4,11+k,4]],
2924		[[1,2,6,12+k],[1,2,13+k,5],[1,6,2,12+k],[1,6,12+k,2],[1,11+k,2,7],[1,11+k,7,2],[1,13+k,2,5],[2,5,3,11+k]],
2925		[[1,2,6,12+k],[1,2,13+k,5],[1,6,2,12+k],[1,6,12+k,2],[1,11+k,4,5],[1,11+k,7,2],[2,2,5,12+k],[2,2,6,11+k],[2,5,3,11+k]],
2926		[[1,2,7,11+k],[1,2,11+k,7],[1,4,1,15+k],[1,4,11+k,5],[1,5,4,11+k],[1,13+k,3,4],[2,3,4,12+k],[2,3,11+k,5],[2,11+k,3,5]],
2927		[[1,2,7,11+k],[1,2,11+k,7],[1,4,2,14+k],[1,4,12+k,4],[1,6,3,11+k],[1,13+k,3,4],[2,3,4,12+k],[2,3,12+k,4],[2,11+k,3,5]],
2928		[[1,2,7,11+k],[1,2,11+k,7],[1,4,2,14+k],[1,4,13+k,3],[1,6,3,11+k],[1,13+k,4,3],[2,2,2,15+k],[2,4,3,12+k],[2,11+k,3,5]],
2929		[[1,2,7,11+k],[1,2,11+k,7],[1,4,5,11+k],[1,4,12+k,4],[1,13+k,3,4],[2,3,4,12+k],[2,3,11+k,5],[2,11+k,3,5]],
2930		[[1,2,7,11+k],[1,2,11+k,7],[1,6,1,13+k],[1,6,12+k,2],[1,7,2,11+k],[1,11+k,3,6],[1,11+k,7,2]],
2931		[[1,2,7,11+k],[1,2,11+k,7],[1,6,3,11+k],[1,6,11+k,3],[1,13+k,4,3],[2,2,2,15+k],[2,4,3,12+k],[2,11+k,4,4]],
2932		[[1,2,7,11+k],[1,2,11+k,7],[1,6,3,11+k],[1,6,11+k,3],[1,13+k,4,3],[2,2,3,14+k],[2,2,5,12+k],[2,3,12+k,4],[2,11+k,4,4]],
2933		[[1,2,7,11+k],[1,2,11+k,7],[1,7,2,11+k],[1,7,11+k,2],[1,11+k,2,7],[1,11+k,7,2]],
2934		[[1,2,7,11+k],[1,2,12+k,6],[1,6,3,11+k],[1,6,12+k,2],[1,11+k,3,6],[1,11+k,7,2]],
2935		[[1,2,7,11+k],[1,2,13+k,5],[1,4,3,13+k],[1,4,11+k,5],[1,5,2,13+k],[1,5,4,11+k],[2,3,4,12+k],[2,3,11+k,5],[3,4,3,11+k]],
2936		[[1,2,7,11+k],[1,2,14+k,4],[1,4,1,15+k],[1,4,11+k,5],[1,5,4,11+k],[2,3,4,12+k],[2,3,11+k,5],[3,4,3,11+k]],
2937		[[1,2,7,11+k],[1,2,14+k,4],[1,4,2,14+k],[1,4,12+k,4],[1,6,3,11+k],[2,3,4,12+k],[2,3,12+k,4],[3,4,3,11+k]],
2938		[[1,2,7,11+k],[1,2,14+k,4],[1,4,5,11+k],[1,4,12+k,4],[2,3,4,12+k],[2,3,11+k,5],[3,4,3,11+k]],
2939		[[1,2,7,11+k],[1,2,15+k,3],[1,6,3,11+k],[1,6,11+k,3],[2,2,2,15+k],[2,4,3,12+k],[3,3,11+k,4]],
2940		[[1,2,7,11+k],[1,2,15+k,3],[1,6,3,11+k],[1,6,11+k,3],[2,2,3,14+k],[2,2,5,12+k],[2,3,12+k,4],[3,3,11+k,4]],
2941		[[1,2,7,11+k],[1,2,15+k,3],[1,6,3,11+k],[1,6,11+k,3],[2,2,5,12+k],[2,2,6,11+k],[2,3,3,13+k],[2,3,12+k,4],[2,5,3,11+k]],
2942		[[1,2,7,11+k],[1,2,16+k,2],[1,6,3,11+k],[1,6,12+k,2],[2,3,12+k,4],[2,12+k,3,4],[2,12+k,4,3],[3,4,3,11+k]],
2943		[[1,2,7,11+k],[1,2,16+k,2],[1,7,2,11+k],[1,7,11+k,2],[2,2,2,15+k],[2,3,2,14+k],[2,4,2,13+k],[2,5,2,12+k],[2,6,2,11+k]],
2944		[[1,2,7,11+k],[1,2,16+k,2],[1,7,2,11+k],[1,7,11+k,2],[2,3,2,14+k],[2,4,4,11+k],[2,4,11+k,4],[2,5,2,12+k],[2,11+k,4,4]],
2945		[[1,2,7,11+k],[1,2,16+k,2],[1,7,2,11+k],[1,7,11+k,2],[2,3,12+k,4],[2,4,2,13+k],[2,4,3,12+k],[2,6,2,11+k],[2,12+k,4,3]],
2946		[[1,2,11+k,7],[1,2,13+k,5],[1,4,11+k,5],[1,4,12+k,4],[1,11+k,2,7],[1,11+k,5,4],[2,2,5,12+k],[2,2,11+k,6],[2,5,3,11+k]],
2947		[[1,2,11+k,7],[1,2,13+k,5],[1,13+k,2,5],[2,2,2,15+k],[2,3,2,14+k],[2,3,11+k,5],[2,4,2,13+k],[2,11+k,5,3]],
2948		[[1,2,11+k,7],[1,2,13+k,5],[1,13+k,2,5],[2,2,3,14+k],[2,2,11+k,6],[2,3,3,13+k],[3,3,4,11+k],[3,4,3,11+k]],
2949		[[1,2,11+k,7],[1,2,14+k,4],[1,13+k,3,4],[2,2,6,11+k],[2,2,14+k,3],[2,6,2,11+k],[2,13+k,3,3],[3,3,11+k,4]],
2950		[[1,2,11+k,7],[1,2,14+k,4],[1,13+k,3,4],[2,2,13+k,4],[2,2,14+k,3],[2,11+k,4,4],[2,13+k,3,3],[3,3,11+k,4]],
2951		[[1,2,11+k,7],[1,2,15+k,3],[1,13+k,4,3],[2,2,11+k,6],[2,2,13+k,4],[3,3,4,11+k],[3,4,3,11+k]],
2952		[[1,2,11+k,7],[1,2,15+k,3],[1,13+k,4,3],[2,2,13+k,4],[2,2,14+k,3],[2,11+k,3,5],[2,13+k,3,3],[3,4,3,11+k]],
2953		[[1,2,12+k,6],[1,2,13+k,5],[1,3,6,11+k],[1,3,12+k,5],[1,6,2,12+k],[1,6,11+k,3],[1,8,1,11+k],[1,11+k,3,6],[1,12+k,5,3]],
2954		[[1,2,13+k,5],[1,2,14+k,4],[1,11+k,4,5],[1,11+k,5,4],[2,2,6,11+k],[2,2,12+k,5],[2,6,2,11+k],[2,11+k,5,3],[2,12+k,4,3]],
2955		[[1,2,13+k,5],[1,2,14+k,4],[1,11+k,4,5],[1,11+k,5,4],[2,2,12+k,5],[2,2,13+k,4],[2,11+k,4,4],[2,11+k,5,3],[2,12+k,4,3]],
2956		[[1,2,13+k,5],[1,2,15+k,3],[1,12+k,3,5],[1,12+k,5,3],[2,2,11+k,6],[2,2,12+k,5],[2,11+k,3,5],[2,12+k,3,4],[3,3,4,11+k]],
2957		[[1,2,14+k,4],[1,2,15+k,3],[1,13+k,3,4],[1,13+k,4,3],[2,2,11+k,6],[2,2,13+k,4],[2,11+k,3,5],[3,3,4,11+k]],
2958		[[1,3,1,16+k],[1,3,4,13+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,12+k,3],[1,7,2,11+k],[2,2,11+k,6],[2,2,13+k,4],[2,12+k,3,4]],
2959		[[1,3,1,16+k],[1,3,6,11+k],[1,4,12+k,4],[1,5,2,13+k],[1,5,12+k,3],[1,7,2,11+k],[2,2,6,11+k],[2,2,12+k,5],[2,6,2,11+k]],
2960		[[1,3,1,16+k],[1,3,6,11+k],[1,4,12+k,4],[1,5,2,13+k],[1,5,12+k,3],[1,7,2,11+k],[2,2,12+k,5],[2,2,13+k,4],[2,11+k,4,4]],
2961		[[1,3,1,16+k],[1,3,6,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,12+k,3],[2,2,2,15+k],[2,4,11+k,4]],
2962		[[1,3,1,16+k],[1,3,6,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,12+k,3],[2,2,4,13+k],[2,2,6,11+k],[2,4,4,11+k]],
2963		[[1,3,1,16+k],[1,3,6,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,12+k,3],[2,2,6,11+k],[2,2,11+k,6],[2,6,2,11+k]],
2964		[[1,3,1,16+k],[1,3,6,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,12+k,3],[2,2,11+k,6],[2,2,13+k,4],[2,11+k,4,4]],
2965		[[1,3,2,15+k],[1,3,4,13+k],[1,4,5,11+k],[1,4,12+k,4],[1,5,11+k,4],[1,7,2,11+k],[2,2,12+k,5],[2,2,14+k,3],[2,11+k,4,4]],
2966		[[1,3,2,15+k],[1,3,4,13+k],[1,5,2,13+k],[2,11+k,3,5],[2,11+k,4,4],[2,13+k,3,3],[3,3,11+k,4],[3,4,3,11+k]],
2967		[[1,3,2,15+k],[1,3,6,11+k],[1,4,5,11+k],[1,4,12+k,4],[1,5,11+k,4],[2,2,2,15+k],[2,4,12+k,3]],
2968		[[1,3,2,15+k],[1,3,6,11+k],[1,4,5,11+k],[1,4,12+k,4],[1,5,11+k,4],[2,2,12+k,5],[2,2,14+k,3],[2,12+k,3,4]],
2969		[[1,3,2,15+k],[1,3,6,11+k],[1,5,2,13+k],[1,7,2,11+k],[2,11+k,3,5],[2,12+k,3,4],[2,13+k,3,3],[3,3,11+k,4],[3,4,3,11+k]],
2970		[[1,3,2,15+k],[1,3,11+k,6],[1,5,11+k,4],[1,14+k,2,4],[2,3,2,14+k],[2,3,11+k,5],[2,4,11+k,4]],
2971		[[1,3,2,15+k],[1,3,11+k,6],[1,5,11+k,4],[1,14+k,2,4],[2,3,5,11+k],[2,3,13+k,3],[2,4,11+k,4],[2,5,3,11+k]],
2972		[[1,3,2,15+k],[1,3,12+k,5],[1,4,2,14+k],[1,4,11+k,5],[1,5,3,12+k],[1,6,2,12+k],[2,2,11+k,6],[2,2,12+k,5],[2,11+k,5,3]],
2973		[[1,3,2,15+k],[1,3,12+k,5],[1,4,4,12+k],[1,4,11+k,5],[1,5,3,12+k],[2,2,11+k,6],[2,2,13+k,4],[2,11+k,5,3]],
2974		[[1,3,2,15+k],[1,3,12+k,5],[1,5,1,14+k],[1,6,11+k,3],[1,11+k,3,6],[1,11+k,6,3],[2,4,11+k,4],[2,4,12+k,3]],
2975		[[1,3,2,15+k],[1,3,12+k,5],[1,5,12+k,3],[1,11+k,4,5],[1,11+k,6,3],[2,4,11+k,4],[2,4,12+k,3]],
2976		[[1,3,2,15+k],[1,3,13+k,4],[1,4,1,15+k],[1,4,11+k,5],[2,2,11+k,6],[2,2,13+k,4],[2,11+k,5,3]],
2977		[[1,3,2,15+k],[1,3,13+k,4],[1,4,3,13+k],[1,4,12+k,4],[1,5,4,11+k],[1,7,2,11+k],[2,2,11+k,6],[2,2,13+k,4],[2,12+k,4,3]],
2978		[[1,3,2,15+k],[1,3,13+k,4],[1,4,5,11+k],[1,4,12+k,4],[1,5,2,13+k],[1,7,2,11+k],[2,2,12+k,5],[2,2,13+k,4],[2,11+k,5,3]],
2979		[[1,3,2,15+k],[1,3,13+k,4],[1,4,5,11+k],[1,4,12+k,4],[1,5,4,11+k],[2,2,11+k,6],[2,2,13+k,4],[2,11+k,5,3]],
2980		[[1,3,2,15+k],[1,3,13+k,4],[1,5,11+k,4],[2,3,2,14+k],[2,3,11+k,5],[2,4,4,11+k],[2,4,11+k,4],[2,5,3,11+k]],
2981		[[1,3,2,15+k],[1,3,13+k,4],[1,5,11+k,4],[2,3,5,11+k],[2,3,13+k,3],[2,4,4,11+k],[2,4,11+k,4]],
2982		[[1,3,3,14+k],[1,3,14+k,3],[1,4,2,14+k],[1,4,13+k,3],[2,2,11+k,6],[2,2,13+k,4],[2,11+k,3,5],[3,3,4,11+k]],
2983		[[1,3,3,14+k],[1,3,14+k,3],[1,4,4,12+k],[1,4,13+k,3],[1,6,2,12+k],[2,2,11+k,6],[2,2,12+k,5],[2,11+k,3,5],[3,3,4,11+k]],
2984		[[1,3,3,14+k],[1,3,14+k,3],[1,6,11+k,3],[2,2,2,15+k],[2,4,11+k,4],[3,3,4,11+k]],
2985		[[1,3,3,14+k],[1,3,14+k,3],[1,6,11+k,3],[2,2,4,13+k],[2,2,6,11+k],[2,4,4,11+k],[3,3,4,11+k]],
2986		[[1,3,3,14+k],[1,3,14+k,3],[1,6,11+k,3],[2,2,6,11+k],[2,2,11+k,6],[2,6,2,11+k],[3,3,4,11+k]],
2987		[[1,3,3,14+k],[1,3,14+k,3],[1,6,11+k,3],[2,2,6,11+k],[2,2,14+k,3],[2,6,2,11+k],[2,11+k,3,5],[2,13+k,3,3]],
2988		[[1,3,3,14+k],[1,3,14+k,3],[1,6,11+k,3],[2,2,11+k,6],[2,2,13+k,4],[2,11+k,4,4],[3,3,4,11+k]],
2989		[[1,3,3,14+k],[1,3,14+k,3],[1,6,11+k,3],[2,2,13+k,4],[2,2,14+k,3],[2,11+k,3,5],[2,11+k,4,4],[2,13+k,3,3]],
2990		[[1,3,4,13+k],[1,3,6,11+k],[1,4,5,11+k],[1,4,12+k,4],[1,5,2,13+k],[1,5,11+k,4],[2,2,12+k,5],[2,2,13+k,4],[2,12+k,3,4]],
2991		[[1,3,4,13+k],[1,3,12+k,5],[1,4,4,12+k],[1,4,11+k,5],[1,5,2,13+k],[1,5,3,12+k],[2,2,11+k,6],[2,2,14+k,3],[2,11+k,5,3]],
2992		[[1,3,4,13+k],[1,3,13+k,4],[1,4,1,15+k],[1,4,11+k,5],[1,5,2,13+k],[2,2,11+k,6],[2,2,14+k,3],[2,11+k,5,3]],
2993		[[1,3,4,13+k],[1,3,13+k,4],[1,4,1,15+k],[1,4,11+k,5],[1,5,4,11+k],[1,7,2,11+k],[2,2,12+k,5],[2,2,14+k,3],[2,11+k,5,3]],
2994		[[1,3,4,13+k],[1,3,13+k,4],[1,4,5,11+k],[1,4,12+k,4],[1,5,2,13+k],[1,5,4,11+k],[2,2,11+k,6],[2,2,14+k,3],[2,11+k,5,3]],
2995		[[1,3,4,13+k],[1,3,13+k,4],[1,4,5,11+k],[1,4,12+k,4],[1,7,2,11+k],[2,2,2,15+k],[2,4,12+k,3],[2,11+k,5,3],[2,12+k,3,4]],
2996		[[1,3,4,13+k],[1,3,13+k,4],[1,4,5,11+k],[1,4,12+k,4],[1,7,2,11+k],[2,2,12+k,5],[2,2,14+k,3],[2,11+k,5,3]],
2997		[[1,3,5,12+k],[1,3,6,11+k],[1,4,4,12+k],[1,4,13+k,3],[1,5,4,11+k],[1,5,12+k,3],[2,2,2,15+k],[2,4,11+k,4]],
2998		[[1,3,5,12+k],[1,3,11+k,6],[1,5,1,14+k],[1,5,12+k,3],[1,6,3,11+k],[1,8,1,11+k],[1,11+k,6,3],[1,12+k,3,5]],
2999		[[1,3,5,12+k],[1,3,11+k,6],[1,5,3,12+k],[1,5,11+k,4],[1,14+k,2,4],[2,3,5,11+k],[2,3,12+k,4],[2,4,11+k,4],[2,5,3,11+k]],
3000		[[1,3,5,12+k],[1,3,12+k,5],[1,4,4,12+k],[1,4,11+k,5],[2,2,2,15+k],[2,3,5,11+k],[2,3,12+k,4],[2,4,4,11+k]],
3001		[[1,3,5,12+k],[1,3,12+k,5],[1,4,4,12+k],[1,4,11+k,5],[2,2,3,14+k],[2,2,5,12+k],[2,3,5,11+k],[2,4,3,12+k],[2,4,4,11+k]],
3002		[[1,3,5,12+k],[1,3,12+k,5],[1,4,4,12+k],[1,4,13+k,3],[1,11+k,4,5],[1,11+k,6,3],[2,2,2,15+k],[2,4,11+k,4]],
3003		[[1,3,5,12+k],[1,3,12+k,5],[1,5,4,11+k],[1,5,12+k,3],[1,8,1,11+k],[1,11+k,6,3],[1,12+k,3,5]],
3004		[[1,3,5,12+k],[1,3,12+k,5],[1,6,2,12+k],[1,6,11+k,3],[1,11+k,4,5],[1,11+k,6,3],[2,2,11+k,6],[2,2,12+k,5],[2,11+k,3,5]],
3005		[[1,3,5,12+k],[1,3,13+k,4],[1,5,3,12+k],[1,5,11+k,4],[2,3,5,11+k],[2,3,12+k,4],[2,4,4,11+k],[2,4,11+k,4]],
3006		[[1,3,5,12+k],[1,3,14+k,3],[1,6,2,12+k],[1,6,11+k,3],[2,2,6,11+k],[2,2,14+k,3],[2,6,2,11+k],[2,11+k,3,5],[2,12+k,4,3]],
3007		[[1,3,5,12+k],[1,3,14+k,3],[1,6,2,12+k],[1,6,11+k,3],[2,2,13+k,4],[2,2,14+k,3],[2,11+k,3,5],[2,11+k,4,4],[2,12+k,4,3]],
3008		[[1,3,6,11+k],[1,3,11+k,6],[1,5,1,14+k],[1,5,12+k,3],[1,6,3,11+k],[1,11+k,4,5],[1,11+k,6,3]],
3009		[[1,3,6,11+k],[1,3,11+k,6],[1,5,4,11+k],[1,5,11+k,4],[1,14+k,2,4],[2,3,2,14+k],[2,3,11+k,5],[2,4,12+k,3]],
3010		[[1,3,6,11+k],[1,3,11+k,6],[1,5,4,11+k],[1,5,11+k,4],[1,14+k,2,4],[2,3,5,11+k],[2,3,13+k,3],[2,4,12+k,3],[2,5,3,11+k]],
3011		[[1,3,6,11+k],[1,3,11+k,6],[1,6,3,11+k],[1,6,11+k,3],[1,11+k,3,6],[1,11+k,6,3]],
3012		[[1,3,6,11+k],[1,3,12+k,5],[1,5,4,11+k],[1,5,12+k,3],[1,11+k,4,5],[1,11+k,6,3]],
3013		[[1,3,6,11+k],[1,3,13+k,4],[1,4,3,13+k],[1,4,12+k,4],[1,7,2,11+k],[2,2,2,15+k],[2,4,12+k,3],[2,11+k,4,4],[2,12+k,4,3]],
3014		[[1,3,6,11+k],[1,3,13+k,4],[1,4,5,11+k],[1,4,12+k,4],[2,2,2,15+k],[2,4,12+k,3],[2,11+k,4,4],[2,11+k,5,3]],
3015		[[1,3,6,11+k],[1,3,13+k,4],[1,4,5,11+k],[1,4,12+k,4],[2,2,12+k,5],[2,2,14+k,3],[2,11+k,4,4],[2,11+k,5,3],[2,12+k,3,4]],
3016		[[1,3,6,11+k],[1,3,13+k,4],[1,5,4,11+k],[1,5,11+k,4],[2,3,2,14+k],[2,3,11+k,5],[2,4,4,11+k],[2,4,12+k,3],[2,5,3,11+k]],
3017		[[1,3,6,11+k],[1,3,13+k,4],[1,5,4,11+k],[1,5,11+k,4],[2,3,5,11+k],[2,3,13+k,3],[2,4,4,11+k],[2,4,12+k,3]],
3018		[[1,3,6,11+k],[1,3,14+k,3],[1,5,4,11+k],[1,5,12+k,3],[2,3,4,12+k],[2,3,12+k,4],[2,4,3,12+k],[2,4,11+k,4]],
3019		[[1,3,11+k,6],[1,3,13+k,4],[1,12+k,2,6],[1,12+k,4,4],[2,2,3,14+k],[2,2,5,12+k],[2,3,3,13+k],[3,3,4,11+k],[3,4,3,11+k]],
3020		[[1,3,11+k,6],[1,3,13+k,4],[1,14+k,2,4],[2,2,3,14+k],[2,2,4,13+k],[2,3,3,13+k],[3,3,4,11+k],[3,4,3,11+k]],
3021		[[1,3,11+k,6],[1,3,13+k,4],[1,14+k,2,4],[2,3,2,14+k],[2,3,11+k,5],[2,4,11+k,4],[2,11+k,4,4],[2,11+k,5,3]],
3022		[[1,4,1,15+k],[1,4,11+k,5],[1,5,11+k,4],[2,2,2,15+k],[2,4,11+k,4]],
3023		[[1,4,1,15+k],[1,4,11+k,5],[1,5,11+k,4],[2,2,4,13+k],[2,2,6,11+k],[2,4,4,11+k]],
3024		[[1,4,1,15+k],[1,4,11+k,5],[1,5,11+k,4],[2,2,6,11+k],[2,2,11+k,6],[2,6,2,11+k]],
3025		[[1,4,1,15+k],[1,4,11+k,5],[1,5,11+k,4],[3,3,4,11+k],[3,3,11+k,4],[3,4,3,11+k]],
3026		[[1,4,3,13+k],[1,4,12+k,4],[1,5,2,13+k],[1,5,11+k,4],[2,2,6,11+k],[2,2,12+k,5],[2,6,2,11+k],[2,11+k,5,3],[2,12+k,4,3]],
3027		[[1,4,3,13+k],[1,4,12+k,4],[1,5,2,13+k],[1,5,11+k,4],[2,2,12+k,5],[2,2,13+k,4],[2,11+k,4,4],[2,11+k,5,3],[2,12+k,4,3]],
3028		[[1,4,5,11+k],[1,4,12+k,4],[1,5,2,13+k],[1,5,11+k,4],[1,7,2,11+k],[2,2,6,11+k],[2,2,12+k,5],[2,6,2,11+k]],
3029		[[1,4,5,11+k],[1,4,12+k,4],[1,5,2,13+k],[1,5,11+k,4],[1,7,2,11+k],[2,2,12+k,5],[2,2,13+k,4],[2,11+k,4,4]],
3030		[[1,4,5,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,11+k,4],[2,2,2,15+k],[2,4,11+k,4]],
3031		[[1,4,5,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,11+k,4],[2,2,4,13+k],[2,2,6,11+k],[2,4,4,11+k]],
3032		[[1,4,5,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,11+k,4],[2,2,6,11+k],[2,2,11+k,6],[2,6,2,11+k]],
3033		[[1,4,5,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,11+k,4],[2,2,11+k,6],[2,2,13+k,4],[2,11+k,4,4]],
3034		[[1,4,5,11+k],[1,4,12+k,4],[1,5,4,11+k],[1,5,11+k,4],[3,3,4,11+k],[3,3,11+k,4],[3,4,3,11+k]],
3035		[[2,2,2,15+k],[2,3,2,14+k],[2,3,5,11+k],[2,4,2,13+k],[2,5,11+k,3],[2,6,2,11+k],[2,11+k,3,5]],
3036		[[2,2,2,15+k],[2,3,5,11+k],[2,3,13+k,3],[2,4,2,13+k],[2,6,2,11+k],[2,11+k,5,3]],
3037		[[2,2,2,15+k],[2,4,11+k,4],[3,3,4,11+k],[3,3,11+k,4],[3,4,3,11+k]],
3038		[[2,2,3,14+k],[2,2,4,13+k],[2,3,3,13+k],[2,4,4,11+k],[2,5,3,11+k],[3,3,4,11+k],[3,4,3,11+k]],
3039		[[2,2,3,14+k],[2,2,11+k,6],[2,3,3,13+k],[2,5,3,11+k],[2,6,2,11+k],[3,3,4,11+k],[3,4,3,11+k]],
3040		[[2,2,4,13+k],[2,2,6,11+k],[2,4,4,11+k],[3,3,4,11+k],[3,3,11+k,4],[3,4,3,11+k]],
3041		[[2,2,4,13+k],[2,2,11+k,6],[2,4,4,11+k],[2,6,2,11+k]],
3042		[[2,2,6,11+k],[2,2,11+k,6],[2,6,2,11+k],[3,3,4,11+k],[3,3,11+k,4],[3,4,3,11+k]],
3043		[[2,3,2,14+k],[2,3,5,11+k],[2,4,4,11+k],[2,4,11+k,4],[2,5,11+k,3],[2,11+k,3,5],[2,11+k,4,4]],
3044		[[2,3,5,11+k],[2,3,13+k,3],[2,4,4,11+k],[2,4,11+k,4],[2,11+k,4,4],[2,11+k,5,3]]
3045  ];
3046
3047	c:=SCFromDifferenceCycles(dc[i]);
3048	SCRename(c,Concatenation(["K^",String(i),"_",String(k)]));
3049
3050	return c;
3051
3052end);
3053
3054################################################################################
3055##<#GAPDoc Label="SCSeriesPrimeTorus">
3056## <ManSection>
3057## <Func Name="SCSeriesPrimeTorus" Arg="l,j,p"/>
3058## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3059## <Description>
3060## Generates the well known triangulated torus <M>\{ (l:j:p-l-j),(l:p-l-j:j) \}</M> with <M>p</M> vertices, <M>3p</M> edges and <M>2p</M> triangles where <M>j</M> has to be greater than <M>l</M> and <M>p</M> must be any prime number greater than <M>6</M>.
3061## <Example>
3062## gap> l:=List([2..19],x->SCSeriesPrimeTorus(1,x,41));;
3063## gap> Set(List(l,x->SCHomology(x)));
3064## gap>
3065## </Example>
3066## </Description>
3067## </ManSection>
3068##<#/GAPDoc>
3069################################################################################
3070InstallGlobalFunction(SCSeriesPrimeTorus,
3071function(l,j,p)
3072
3073	local c;
3074
3075	if not IsPosInt(l) or not IsPosInt(j) or not IsPosInt(p) or not IsPrime(p) or not l < j or not j < p-l-j or p < 7 then
3076		Info(InfoSimpcomp,1,"SCSeriesPrimeTorus: arguments must be positive integers l < j < p-l-j, and p must be a prime number > 6.");
3077		return fail;
3078	fi;
3079
3080	if not Gcd(l,j) = 1 then
3081		Info(InfoSimpcomp,1,"SCSeriesPrimeTorus: l and j  have to be coprime integers.");
3082		return fail;
3083	fi;
3084
3085	c:=SCFromDifferenceCycles([[l,j,p-l-j],[l,p-l-j,j]]);
3086		SCRename(c,Concatenation(["prime torus S_{(",String(l),",",String(j),",",String(p),")} = { (",String(l),":",String(j),":",String(p-l-j),"),(",String(l),":",String(p-l-j),":",String(j),") }"]));
3087	return c;
3088end);
3089
3090
3091################################################################################
3092##<#GAPDoc Label="SCSeriesNSB1">
3093## <ManSection>
3094## <Func Name="SCSeriesNSB1" Arg="k"/>
3095## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3096## <Description>
3097## Generates the first neighborly sphere bundle NSB<M>_1</M> from <Cite Key="Spreer10Diss"/>, Section 4.5.4. The complex has <M>2k+1</M> vertices, <M>k \geq 4</M>
3098## <Example>
3099## gap> List([4..10],x->SCNeighborliness(SCSeriesNSB1(x)));
3100## [ 2, 2, 2, 2, 2, 2, 2 ]
3101## gap> List([4..10],x->SCFVector(SCSeriesNSB1(x)));
3102## [ [ 9, 36, 54, 27 ], [ 11, 55, 88, 44 ], [ 13, 78, 130, 65 ],
3103##   [ 15, 105, 180, 90 ], [ 17, 136, 238, 119 ], [ 19, 171, 304, 152 ],
3104##   [ 21, 210, 378, 189 ] ]
3105## gap>
3106## </Example>
3107## </Description>
3108## </ManSection>
3109##<#/GAPDoc>
3110################################################################################
3111InstallGlobalFunction(SCSeriesNSB1,
3112function(k)
3113
3114	local dc,c,l;
3115
3116	if not IsPosInt(k) or k < 4 then
3117		Info(InfoSimpcomp,1,"SCSeriesNSB1: argument must be a positive integer > 3.");
3118		return fail;
3119	fi;
3120
3121	dc:=[[1,1,2,2*k-3], [1,1,k+1,k-2], [1,k-2,1,k+1]];
3122
3123	for l in [2..k-3] do
3124	  Add(dc,[1,l,2,2*k-2-l]);
3125	od;
3126
3127	c:=SCFromDifferenceCycles(dc);
3128		SCRename(c,Concatenation(["Neighborly sphere bundle NSB_1"]));
3129	return c;
3130end);
3131
3132################################################################################
3133##<#GAPDoc Label="SCSeriesNSB2">
3134## <ManSection>
3135## <Func Name="SCSeriesNSB2" Arg="k"/>
3136## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3137## <Description>
3138## Generates the second neighborly sphere bundle NSB<M>_2</M> from <Cite Key="Spreer10Diss"/>, Section 4.5.4. The complex has <M>2k</M> vertices, <M>k \geq 5</M>
3139## <Example>
3140## gap> List([5..10],x->SCNeighborliness(SCSeriesNSB2(x)));
3141## [ 2, 2, 2, 2, 2, 2 ]
3142## gap> List([5..10],x->SCFVector(SCSeriesNSB2(x)));
3143## [ [ 10, 45, 70, 35 ], [ 12, 66, 108, 54 ], [ 14, 91, 154, 77 ],
3144##   [ 16, 120, 208, 104 ], [ 18, 153, 270, 135 ], [ 20, 190, 340, 170 ] ]
3145## gap>
3146## </Example>
3147## </Description>
3148## </ManSection>
3149##<#/GAPDoc>
3150################################################################################
3151InstallGlobalFunction(SCSeriesNSB2,
3152function(k)
3153
3154	local dc,c,l;
3155
3156	if not IsPosInt(k) or k < 5 then
3157		Info(InfoSimpcomp,1,"SCSeriesNSB2: argument must be a positive integer > 4.");
3158		return fail;
3159	fi;
3160
3161	dc:=[[1,1,3,2*k-5], [1,1,k,k-2], [1,3,1,2*k-5], [2,k-2,2,k-2]];
3162
3163	for l in [1..k-5] do
3164	  Add(dc,[1,k-1+l,2,k-l-2]);
3165	od;
3166
3167	c:=SCFromDifferenceCycles(dc);
3168		SCRename(c,Concatenation(["Neighborly sphere bundle NSB_2"]));
3169	return c;
3170end);
3171
3172################################################################################
3173##<#GAPDoc Label="SCSeriesNSB3">
3174## <ManSection>
3175## <Func Name="SCSeriesNSB3" Arg="k"/>
3176## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3177## <Description>
3178## Generates the third neighborly sphere bundle NSB<M>_3</M> from <Cite Key="Spreer10Diss"/>, Section 4.5.4. The complex has <M>k</M> vertices, <M>k \geq 11</M>
3179## <Example>
3180## gap> List([11..15],x->SCNeighborliness(SCSeriesNSB3(x)));
3181## [ 2, 2, 2, 2, 2 ]
3182## gap> List([11..15],x->SCFVector(SCSeriesNSB3(x)));
3183## [ [ 11, 55, 88, 44 ], [ 12, 66, 108, 54 ], [ 13, 78, 130, 65 ],
3184##   [ 14, 91, 154, 77 ], [ 15, 105, 180, 90 ] ]
3185## gap>
3186## </Example>
3187## </Description>
3188## </ManSection>
3189##<#/GAPDoc>
3190################################################################################
3191InstallGlobalFunction(SCSeriesNSB3,
3192function(k)
3193
3194	local dc,c,l;
3195
3196	if not IsPosInt(k) or k < 11 then
3197		Info(InfoSimpcomp,1,"SCSeriesNSB3: argument must be a positive integer > 10.");
3198		return fail;
3199	fi;
3200
3201	dc:=[[1,1,1,k-3], [1,2,4,k-7], [1,4,2,k-7], [1,4,k-7,2]];
3202
3203	for l in [4..k-8] do
3204	  Add(dc,[2,l,2,k-l-4]);
3205	od;
3206
3207	c:=SCFromDifferenceCycles(dc);
3208		SCRename(c,Concatenation(["Neighborly sphere bundle NSB_3"]));
3209	return c;
3210end);
3211
3212
3213################################################################################
3214##<#GAPDoc Label="SCSeriesTorus">
3215## <ManSection>
3216## <Func Name="SCSeriesTorus" Arg="d"/>
3217## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3218## <Description>
3219## Generates the <M>d</M>-torus described in <Cite Key="Kuehnel86HigherDimCsaszar"/>.
3220## <Example>
3221## gap> t4:=SCSeriesTorus(4);
3222## gap> t4.Homology;
3223## </Example>
3224## </Description>
3225## </ManSection>
3226##<#/GAPDoc>
3227################################################################################
3228InstallGlobalFunction(SCSeriesTorus,
3229function(d)
3230
3231	local dc, base, i, j, c;
3232
3233	if not IsPosInt(d) or d < 1 then
3234		Info(InfoSimpcomp,1,"SCSeriesTorus: argument must be a positive integer.");
3235		return fail;
3236	fi;
3237
3238  dc:=[];
3239  base:=[];
3240  for j in [1..d] do
3241    Add(base,2^j);
3242  od;
3243  for i in SymmetricGroup(d) do
3244    Add(dc,Concatenation([1],Permuted(base,i)));
3245  od;
3246
3247  c:=SCFromDifferenceCycles(dc);
3248  if d=1 then
3249  	SCRename(c,"S^1");
3250  	SetSCTopologicalType(c,"S^1");
3251  else
3252		SCRename(c,Concatenation([String(d),"-torus T^",String(d)]));
3253		SetSCTopologicalType(c,Concatenation(["T^",String(d)]));
3254	fi;
3255	return c;
3256end);
3257
3258################################################################################
3259##<#GAPDoc Label="SCSeriesLensSpace">
3260## <ManSection>
3261## <Func Name="SCSeriesLensSpace" Arg="p,q"/>
3262## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3263## <Description>
3264## Generates the lens space <M>L(p,q)</M> whenever <M>p = (k+2)^2-1</M> and <M>q = k+2</M> or <M>p = 2k+3</M> and <M>q = 1</M>
3265## for a <M>k \geq 0</M> and <K>fail</K> otherwise. All complexes have a transitive cyclic automorphism group.
3266## <Example>
3267## gap> l154:=SCSeriesLensSpace(15,4);
3268## gap> l154.Homology;
3269## gap> g:=SimplifiedFpGroup(SCFundamentalGroup(l154));
3270## gap> StructureDescription(g);
3271## </Example>
3272## <Example>
3273## gap> l151:=SCSeriesLensSpace(15,1);
3274## gap> l151.Homology;
3275## gap> g:=SimplifiedFpGroup(SCFundamentalGroup(l151));
3276## gap> StructureDescription(g);
3277## </Example>
3278## </Description>
3279## </ManSection>
3280##<#/GAPDoc>
3281################################################################################
3282InstallGlobalFunction(SCSeriesLensSpace,
3283function(p,q)
3284
3285  local dc, i, n, c, sqrt, k, str;
3286
3287  if not IsPosInt(p) or not IsPosInt(q) then
3288    Info(InfoSimpcomp,1,"SCSeriesLensSpace: arguments must be positive integers.");
3289    return fail;
3290  fi;
3291
3292  sqrt:=Sqrt(p+1);
3293  if IsInt(sqrt) and q = sqrt then
3294    k:=sqrt-2;
3295    n:=14+4*k;
3296    dc:=[[1,1,1,n-3],[1,2,4,n-7],[1,4,2,n-7],[1,4,n-7,2]];
3297    for i in [0..k] do
3298      Add(dc,[2,5+2*i,2,n-9-2*i]);
3299    od;
3300    for i in [0..k] do
3301      Add(dc,[4,2+2*i,4,n-10-2*i]);
3302    od;
3303    c:=SCFromDifferenceCycles(dc);
3304  elif IsOddInt(p) and p > 2 and q = 1 then
3305    c:=SCIntFunc.SeifertFibredSpace(2,p,2);
3306  else
3307    Info(InfoSimpcomp,1,"SCSeriesLensSpace: only lens spaces of type L((k+1)^2-1,k+1) and L(2k+1,1), k > 0, can be generated.");
3308    return fail;
3309  fi;
3310
3311  str:=Concatenation("L(",String(p),",",String(q),")");
3312  SCRename(c,Concatenation("Lens space ",str));
3313  SetSCTopologicalType(c,str);
3314  return c;
3315end);
3316
3317################################################################################
3318##<#GAPDoc Label="SCSeriesBrehmKuehnelTorus">
3319## <ManSection>
3320## <Func Name="SCSeriesBrehmKuehnelTorus" Arg="n"/>
3321## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3322## <Description>
3323## Generates a neighborly 3-torus with <Arg>n</Arg> vertices if <Arg>n</Arg> is odd and a centrally symmetric 3-torus if <Arg>n</Arg> is even (<Arg>n</Arg><M>\geq 15</M> . The triangulations are taken from <Cite Key="Brehm09LatticeTrigE33Torus"/>
3324## <Example>
3325## gap> T3:=SCSeriesBrehmKuehnelTorus(15);
3326## gap> T3.Homology;
3327## gap> T3.Neighborliness;
3328## gap> T3:=SCSeriesBrehmKuehnelTorus(16);
3329## gap> T3.Homology;
3330## gap> T3.IsCentrallySymmetric;
3331## </Example>
3332## </Description>
3333## </ManSection>
3334##<#/GAPDoc>
3335################################################################################
3336InstallGlobalFunction(SCSeriesBrehmKuehnelTorus,
3337function(n)
3338
3339	local k, dc, i, c;
3340
3341	if (not IsInt(n)) or (n < 15) then
3342		Info(InfoSimpcomp,1,"SCSeriesBrehmKuehnelTorus: argument must be an integer greater or equal to 15.");
3343		return fail;
3344	fi;
3345
3346	if n mod 4 = 3 then
3347		k := (n+1)/4;
3348		dc := [[1,k-2,k,2*k],[1,k,2,3*k-4],[1,k,2*k,k-2],[1,2*k,k-2,k],[1,2,3*k-4,k],[1,3*k-4,k,2]];
3349		for i in Union([2..k-3],[k+2..2*k-3]) do
3350			Add(dc,[1,i,1,4*k-i-3]);
3351		od;
3352	elif n mod 4 = 0 then
3353		k := n/4;
3354		dc := [[1,k-2,k,2*k+1],[1,k,2,3*k-3],[1,k,2*k+1,k-2],[1,2*k+1,k-2,k],[1,2,3*k-3,k],[1,3*k-3,k,2]];
3355		for i in Union([2..k-3],[k+2..2*k-3]) do
3356			Add(dc,[1,i,1,4*k-i-2]);
3357		od;
3358	elif n mod 4 = 1 then
3359		k := (n-1)/4;
3360		dc := [[1,k-2,k+1,2*k+1],[1,k,2,3*k-2],[1,k,2*k+2,k-2],[1,2*k+1,k-1,k],[1,2,3*k-2,k],[1,3*k-2,k,2]];
3361		for i in Union([2..k-3],[k+2..2*k-2]) do
3362			Add(dc,[1,i,1,4*k-i-1]);
3363		od;
3364	elif n mod 4 = 2 then
3365		k := (n-2)/4;
3366		dc := [[1,k-2,k+1,2*k+2],[1,k,2,3*k-1],[1,k,2*k+3,k-2],[1,2*k+2,k-1,k],[1,2,3*k-1,k],[1,3*k-1,k,2]];
3367		for i in Union([2..k-3],[k+2..2*k-2]) do
3368			Add(dc,[1,i,1,4*k-i]);
3369		od;
3370	fi;
3371
3372	c := SCFromDifferenceCycles(dc);
3373	if n mod 2 = 0 then
3374		SCRename(c,Concatenation("Centrally symmetric 3-Torus SCT3(",String(n),")"));
3375	elif n mod 2 = 1 then
3376		SCRename(c,Concatenation("Neighborly 3-Torus NT3(",String(n),")"));
3377	fi;
3378	SetSCTopologicalType(c,"T^3");
3379	return c;
3380end);
3381
3382SCIntFunc.SeifertFibredSpace:=function(p,q,r)
3383	local dc,i,k,l,m,gcd,n,a,b,tmp;
3384
3385	gcd:=function(l,m,n,r)
3386		local dc;
3387		dc:=[];
3388		while l > m do
3389			l:=l-m;
3390			Add(dc,[m,l,m,n-2*m-l+r]);
3391		od;
3392		return [m,l,dc];
3393	end;
3394
3395	# make sure p,q co-prime
3396	if GCD_INT(p,q) <> 1 then
3397		Info(InfoSimpcomp,1,"SCIntFunc.SeifertFibredSpace: arguments one and two must be co-prime.");
3398		return fail;
3399	fi;
3400
3401	# always finds a solution since p and q are co-prime
3402	k:=0;
3403	for i in [1..p-1] do
3404		if IsInt((i*q+1)/p) then
3405			k:=i;
3406			break;
3407		fi;
3408	od;
3409
3410	# seed triangulation
3411	a:=k*q;
3412	b:=(p-k)*q-1;
3413	dc:=[[1,a,b,p*q+r],[1,a,p*q+r,b],[1,p*q+r,a,b]];
3414
3415	# 1st exceptional fibre (p,x)
3416	if b > p*q-b then
3417		l:=b;
3418		m:=p*q-b;
3419	else
3420		l:=p*q-b;
3421		m:=b;
3422	fi;
3423	while l>p do
3424		tmp:=gcd(l,m,2*p*q,r);
3425		l:=tmp[1];
3426		m:=tmp[2];
3427		Append(dc,tmp[3]);
3428	od;
3429
3430	# 2nd exceptional fibre (q,x)
3431	if a > p*q-a then
3432		l:=a;
3433		m:=p*q-a;
3434	else
3435		l:=p*q-a;
3436		m:=a;
3437	fi;
3438	while l>q do
3439		tmp:=gcd(l,m,2*p*q,r);
3440		l:=tmp[1];
3441		m:=tmp[2];
3442		Append(dc,tmp[3]);
3443	od;
3444
3445	# 3rd exceptional fibre (r,x)
3446	for i in [0..Int(r/2)] do
3447		Add(dc,[1,p*q-1+i,1,p*q-1+r-i]);
3448	od;
3449
3450	return SCFromDifferenceCycles(dc);
3451end;
3452
3453################################################################################
3454##<#GAPDoc Label="SCSeriesHomologySphere">
3455## <ManSection>
3456## <Func Name="SCSeriesHomologySphere" Arg="p,q,r"/>
3457## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3458## <Description>
3459## Generates a combinatorial Brieskorn homology sphere of type <M>\Sigma (p,q,r)</M>, <M>p</M>, <M>q</M> and <M>r</M>
3460## pairwise co-prime. The complex is a combinatorial <M>3</M>-manifold with transitive cyclic symmetry
3461## as described in <Cite Key="Spreer12VarCyclPolytope"/>.
3462## <Example>
3463## gap> c:=SCSeriesHomologySphere(2,3,5);
3464## gap> c.Homology;
3465## gap> c:=SCSeriesHomologySphere(3,4,13);
3466## gap> c.Homology;
3467## </Example>
3468## </Description>
3469## </ManSection>
3470##<#/GAPDoc>
3471################################################################################
3472InstallGlobalFunction(SCSeriesHomologySphere,
3473function(p,q,r)
3474	local c,l,str;
3475
3476	if not IsPosInt(p) or not IsPosInt(q) or not IsPosInt(r) or GCD_INT(p,q) > 1 or GCD_INT(p,r) > 1 or GCD_INT(q,r) > 1 or not p > 1 or not q > 1 or not r > 1 then
3477		Info(InfoSimpcomp,1,"SCSeriesHomologySphere: arguments must be three positive and pairwise co-prime integer.");
3478		return fail;
3479	fi;
3480	l:=[p,q,r];
3481	Sort(l);
3482	p:=l[1];
3483	q:=l[2];
3484	r:=l[3];
3485
3486	c:= SCIntFunc.SeifertFibredSpace(p,q,r);
3487	str:=Concatenation("Sigma(",String(p),",",String(q),",",String(r),")");
3488	SetSCTopologicalType(c,str);
3489	SCRename(c,Concatenation("Homology sphere ",str));
3490	return c;
3491end);
3492
3493################################################################################
3494##<#GAPDoc Label="SCSeriesConnectedSum">
3495## <ManSection>
3496## <Func Name="SCSeriesConnectedSum" Arg="k"/>
3497## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3498## <Description>
3499## Generates a combinatorial manifold of type <M>(S^2 x S^1)^#k</M> for <M>k</M> even.
3500## The complex is a combinatorial <M>3</M>-manifold with transitive cyclic symmetry
3501## as described in <Cite Key="Spreer12VarCyclPolytope"/>.
3502## <Example>
3503## gap> c:=SCSeriesConnectedSum(12);
3504## gap> c.Homology;
3505## gap> g:=SimplifiedFpGroup(SCFundamentalGroup(c));
3506## gap> RelatorsOfFpGroup(g);
3507## </Example>
3508## </Description>
3509## </ManSection>
3510##<#/GAPDoc>
3511################################################################################
3512InstallGlobalFunction(SCSeriesConnectedSum,
3513function(k)
3514	local c,str;
3515
3516	if not IsEvenInt(k) or k < 2 then
3517		Info(InfoSimpcomp,1,"SCSeriesConnectedSum: argument must be an even positive integer.");
3518		return fail;
3519	fi;
3520
3521	c:= SCIntFunc.SeifertFibredSpace(2,k+1,0);
3522	str:=Concatenation("(S^2xS^1)^#",String(k),")");
3523	SetSCTopologicalType(c,str);
3524	SCRename(c,str);
3525	return c;
3526end);
3527
3528################################################################################
3529##<#GAPDoc Label="SCSeriesSeifertFibredSpace">
3530## <ManSection>
3531## <Func Name="SCSeriesSeifertFibredSpace" Arg="p,q,r"/>
3532## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3533## <Description>
3534## Generates a combinatorial Seifert fibred space of type
3535##
3536## <Display>SFS [ (\mathbb{T}^2)^{(a-1)(b-1)} : (p/a,b_1)^b , (q/b,b_2)^a, (r/ab,b_3) ]</Display>
3537##
3538## where <M>p</M> and <M>q</M> are co-prime, <M>a = \operatorname{gcd} (p,r)</M>, <M>b = \operatorname{gcd} (p,r)</M>,
3539## and the <M>b_i</M> are given by the identity
3540##
3541## <Display>\frac{b_1}{p} + \frac{b_2}{q} + \frac{b_3}{r} = \frac{\pm ab}{pqr}.</Display>
3542##
3543## This <M>3</M>-parameter family of combinatorial <M>3</M>-manifolds contains the
3544## families generated by <Ref Func="SCSeriesHomologySphere"/>, <Ref Func="SCSeriesConnectedSum"/>
3545## and parts of <Ref Func="SCSeriesLensSpace"/>, internally calls <K>SCIntFunc.SeifertFibredSpace(p,q,r)</K>.
3546##
3547## The complexes are combinatorial <M>3</M>-manifolds with transitive cyclic symmetry
3548## as described in <Cite Key="Spreer12VarCyclPolytope"/>.
3549## <Example>
3550## gap> c:=SCSeriesSeifertFibredSpace(2,3,15);
3551## gap> c.Homology;
3552## </Example>
3553## </Description>
3554## </ManSection>
3555##<#/GAPDoc>
3556################################################################################
3557InstallGlobalFunction(SCSeriesSeifertFibredSpace,
3558function(p,q,r)
3559	local c,str,a,b,connSum,orbifold;
3560
3561	if not IsPosInt(p) or not IsPosInt(q) or not IsInt(r) or r < 0 or GCD_INT(p,q) > 1 or p < 2 or q <= p then
3562		Info(InfoSimpcomp,1,"SCSeriesSeifertFibredSpace: arguments must be non-negative integers, first argument must be smaller than second argument and first and second argument mus be co-prime and > 1.");
3563		return fail;
3564	fi;
3565
3566	c:= SCIntFunc.SeifertFibredSpace(p,q,r);
3567	a:=GCD_INT(p,r);
3568	b:=GCD_INT(q,r);
3569	connSum:=(a-1)*(b-1)/2;
3570	if connSum = 0 then
3571		orbifold:="S^2";
3572	elif connSum = 1 then
3573		orbifold:="T^2";
3574	else
3575		orbifold:=Concatenation("(T^2)^#",String(connSum));
3576	fi;
3577	if r = 0 then
3578		str:=Concatenation("(S^2xS^1)^#",String(2*connSum));
3579	else
3580	str:=Concatenation("SFS [ ",orbifold," : ");
3581	if p/a > 1 then
3582		if b > 1 then
3583			str:=Concatenation(str,"(",String(p/a),",b1)^",String(b));
3584		else
3585			str:=Concatenation(str,"(",String(p/a),",b1)");
3586		fi;
3587	fi;
3588	if p/a > 1 and q/b > 1 then
3589		str:=Concatenation(str,", ");
3590	fi;
3591	if q/b > 1 then
3592		if a > 1 then
3593			str:=Concatenation(str,"(",String(q/b),",b2)^",String(a));
3594		else
3595			str:=Concatenation(str,"(",String(q/b),",b2)");
3596		fi;
3597	fi;
3598	if q/b > 1 or (q/b = 1 and p/a > 1) then
3599		str:=Concatenation(str,", (",String(r/(a*b)),",b3)");
3600	else
3601		str:=Concatenation(str,"(",String(r/(a*b)),",b3)");
3602	fi;
3603	fi;
3604	str:=Concatenation(str," ]");
3605	SetSCTopologicalType(c,str);
3606	SCRename(c,str);
3607	return c;
3608end);
3609
3610
3611################################################################################
3612##<#GAPDoc Label="SCSurface">
3613## <ManSection>
3614## <Func Name="SCSurface" Arg="g,orient"/>
3615## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3616## <Description>
3617## Generates the surface of genus <Arg>g</Arg> where the boolean argument <Arg>orient</Arg> specifies
3618## whether the surface is orientable or not. The surfaces have transitive cyclic group actions and
3619## can be described using the minimum amount of <M>O(\operatorname{log} (g))</M> memory.
3620##
3621## If <Arg>orient</Arg> is <C>true</C> and <Arg>g</Arg><M> \geq 50</M> or if
3622## <Arg>orient</Arg> is <C>false</C> and <Arg>g</Arg><M> \geq 100</M> only the difference cycles of the
3623## surface are returned
3624## <Example>
3625## gap> c:=SCSurface(23,true);
3626## gap> c.Homology;
3627## gap> c.TopologicalType;
3628## gap> c:=SCSurface(23,false);
3629## gap> c.Homology;
3630## gap> c.TopologicalType;
3631## </Example>
3632## <Example>
3633## gap> dc:=SCSurface(345,true);
3634## gap> c:=SCFromDifferenceCycles(dc);
3635## gap> c.Chi;
3636## gap> dc:=SCSurface(12345678910,true); time;
3637## </Example>
3638## </Description>
3639## </ManSection>
3640##<#/GAPDoc>
3641################################################################################
3642InstallGlobalFunction(SCSurface,
3643function(g,orient)
3644	local c, G;
3645
3646	if not IsInt(g) or g < 0 then
3647		Info(InfoSimpcomp,1,"SCSurface: first argument must be a non-negative integer.");
3648		return fail;
3649	fi;
3650
3651	if not IsBool(orient) or orient = fail then
3652		Info(InfoSimpcomp,1,"SCSurface: second argument must be a boolean (true or false).");
3653		return fail;
3654	fi;
3655
3656	if g = 0 and orient = false then
3657		Info(InfoSimpcomp,1,"SCSurface: there is no non-orientable surface of genus 0.");
3658		return fail;
3659	fi;
3660
3661	if orient = true then
3662		if g = 0 then
3663			c:=SCBdSimplex(3);
3664		elif g = 1 then
3665			c:=SCSeriesPrimeTorus(1,2,7);
3666		elif g = 2 then
3667			c:=SCFromDifferenceCycles([[1,1,10],[2,4,6],[4,4,4]]);
3668		elif g = 3 then
3669			# Dyck's map
3670			G:=Group([ (1,6)(2,10)(3,11)(4,9)(5,8)(7,12),
3671				   (1,10,8,7,4,2)(3,12,11,9,6,5) ]);
3672			c:=SCFromGenerators(G,[[1,2,4]]);
3673		elif g = 4 then
3674			G:=Group([ (1,12)(2,11)(3,10)(4,9)(5,8)(6,7),
3675				   (1,2,3,4,5,6)(7,8,9,10,11,12) ]);
3676			c:=SCFromGenerators(G,[[1,2,4],[1,2,7],[1,3,10]]);
3677		elif g = 6 then
3678			G:=Group([ (1,9,5)(2,4,3)(6,8,7)(10,12,11),
3679				   (1,4)(2,11)(3,6)(5,8)(7,10)(9,12) ]);
3680			c:=SCFromGenerators(G,[[1,2,4],[1,2,7],[1,3,8],[1,5,9],[1,5,11]]);
3681		elif g = 8 then
3682			G:=Group([ (1,3,5,7,9,11,13)(2,4,6,8,10,12,14),
3683				   (1,8)(2,13,12,7,10,11)(3,4,9,6,5,14) ]);
3684			c:=SCFromGenerators(G,[[1,2,3],[1,3,7]]);
3685		elif IsOddInt(g)  and g < 50 then
3686			c:=SCFromDifferenceCycles([[1,1,4*g-6],[2,g-2,3*g-4],[g-2,g,2*g-2]]);
3687		elif IsEvenInt(g)  and g < 50 then
3688			c:=SCFromDifferenceCycles([[1,1,2*g-4],[2,4,2*g-8],[3,3,2*g-8],[4,g-3,g-3]]);
3689		elif IsOddInt(g)  and g >= 50 then
3690			c:=[[1,1,4*g-6],[2,g-2,3*g-4],[g-2,g,2*g-2]];
3691		elif IsEvenInt(g)  and g >= 50 then
3692			c:=[[1,1,2*g-4],[2,4,2*g-8],[3,3,2*g-8],[4,g-3,g-3]];
3693		fi;
3694	else
3695		if g = 1 then
3696			G:=Group([(1,2,5)(3,4,6),(3,5)(4,6)]);
3697			c:=SCFromGenerators(G,[[1,2,3]]);
3698		elif g = 2 then
3699			c:=SCFromDifferenceCycles([[1,1,8],[2,4,4]]);
3700		elif g = 3 then
3701			Info(InfoSimpcomp,1,"SCSurface: there is no surface of non-orientable genus 3 with transitive automorphism group.");
3702			G:=Group([(1,2,5)(3,4,6),(3,5)(4,6)]);
3703			c:=SCFromGenerators(G,[[1,2,3]]);
3704			return SCConnectedSum(c,SCSeriesPrimeTorus(1,2,7));
3705		elif g = 4 then
3706			G:=Group([ (1,9,5)(2,4,3)(6,8,7)(10,12,11),
3707				   (1,4)(2,11)(3,6)(5,8)(7,10)(9,12) ]);
3708			c:=SCFromGenerators(G,[[1,2,3],[1,2,4],[1,3,8]]);
3709		elif g = 5 then
3710			G:=Group([ (2,9)(3,5)(6,8), (1,8,3)(2,6,4)(5,9,7) ]);
3711			c:=SCFromGenerators(G,[[1,2,4],[1,3,8]]);
3712		elif g = 6 then
3713			Info(InfoSimpcomp,1,"SCSurface: there is no surface of non-orientable genus 6 with transitive automorphism group KNOWN to the authours.");
3714			return fail;
3715			G:=Group(());
3716			c:=SCFromGenerators(G,[]);
3717		elif g = 7 then
3718			G:=Group([ (1,3,5,7,9)(2,4,6,8,10),
3719				   (1,9)(3,4)(5,10)(6,7) ]);
3720			c:=SCFromGenerators(G,[[1,2,3]]);
3721		elif g = 8 then
3722			c:=SCFromDifferenceCycles([[1,2,9],[1,3,8],[2,4,6]]);
3723		elif g = 9 then
3724			G:=Group([ (1,2,17,18,15,13)(3,4,16,9,14,20)(5,10,7,12,21,11)(6,19,8),
3725				   (1,2,3)(4,8,13)(5,9,14)(6,7,15)(10,19,16)(11,20,17)(12,21,18) ]);
3726			c:=SCFromGenerators(G,[[1,2,3],[1,2,4],[1,4,14]]);
3727		elif g = 10 then
3728			G:=Group([ (1,9,5)(2,4,3)(6,8,7)(10,12,11),
3729				   (1,4)(2,11)(3,6)(5,8)(7,10)(9,12) ]);
3730			c:=SCFromGenerators(G,[[1,2,3],[1,2,4],[1,3,7],[1,5,9]]);
3731		elif g = 11 then
3732			G:=Group([ (1,17,10,3,14,11,6,16,7)(2,18,9,4,13,12,5,15,8),
3733				(7,8)(9,10)(11,12)(13,14)(15,16)(17,18) ]);
3734			c:=SCFromGenerators(G,[[1,2,7],[1,7,13]]);
3735		elif g = 12 then
3736			c:=SCFromDifferenceCycles([[1,1,13],[2,3,10],[3,6,6],[5,5,5]]);
3737		elif g = 13 then
3738			Info(InfoSimpcomp,1,"SCSurface: there is no surface of non-orientable genus 13 with transitive automorphism group KNOWN to the authours.");
3739			return fail;
3740			G:=Group(());
3741			c:=SCFromGenerators(G,[]);
3742		elif g = 14 then
3743			c:=SCFromDifferenceCycles([[1,1,16],[2,6,10],[4,4,10],[6,6,6]]);
3744		elif g = 16 then
3745			c:=SCFromDifferenceCycles([[1,1,12],[2,3,9],[3,5,6],[4,4,6]]);
3746		elif IsOddInt(g) and g < 100 then
3747			c:=SCFromDifferenceCycles([[1,1,g-4],[2,(g-7)/2,(g-1)/2],[3,(g-7)/2,(g-3)/2],[3,(g-5)/2,(g-5)/2]]);
3748		elif IsEvenInt(g) and g < 100 then
3749			c:=SCFromDifferenceCycles([[1,1,g-4],[2,(g-8)/2,g/2],[4,(g-8)/2,(g-4)/2],[4,(g-6)/2,(g-6)/2]]);
3750		elif IsOddInt(g) and g >= 100 then
3751			c:=[[1,1,g-4],[2,(g-7)/2,(g-1)/2],[3,(g-7)/2,(g-3)/2],[3,(g-5)/2,(g-5)/2]];
3752		elif IsEvenInt(g) and g >= 100 then
3753			c:=[[1,1,g-4],[2,(g-8)/2,g/2],[4,(g-8)/2,(g-4)/2],[4,(g-6)/2,(g-6)/2]];
3754		fi;
3755
3756
3757	fi;
3758
3759	if (orient and g < 50) or (not orient and g < 100) then
3760		if g = 0 then
3761			SCRename(c,"S^2");
3762			SetSCTopologicalType(c,"S^2");
3763		elif g = 1 and orient then
3764			SCRename(c,"T^2");
3765			SetSCTopologicalType(c,"T^2");
3766		elif g = 1 and not orient then
3767			SCRename(c,"RP^2");
3768			SetSCTopologicalType(c,"RP^2");
3769		elif g = 2 and not orient then
3770			SCRename(c,"K^2");
3771			SetSCTopologicalType(c,"K^2");
3772		elif orient then
3773			SCRename(c,Concatenation("S_",String(g),"^or"));
3774			SetSCTopologicalType(c,Concatenation("(T^2)^#",String(g)));
3775		else
3776			SCRename(c,Concatenation("S_",String(g),"^non"));
3777			SetSCTopologicalType(c,Concatenation("(RP^2)^#",String(g)));
3778		fi;
3779	fi;
3780
3781	return c;
3782end);
3783
3784################################################################################
3785##<#GAPDoc Label="SCSeriesS2xS2">
3786## <ManSection>
3787## <Func Name="SCSeriesS2xS2" Arg="k"/>
3788## <Returns> simplicial complex of type <C>SCSimplicialComplex</C> upon success, <K>fail</K> otherwise.</Returns>
3789## <Description>
3790## Generates a combinatorial version of <M>(S^2 \times S^2)^{\# k}</M>.
3791## <Example>
3792## gap> c:=SCSeriesS2xS2(3);
3793## gap> c.Homology;
3794## </Example>
3795## </Description>
3796## </ManSection>
3797##<#/GAPDoc>
3798################################################################################
3799InstallGlobalFunction(SCSeriesS2xS2,
3800function(k)
3801	local dc, i, n, c, str;
3802	if not IsInt(k) or k < 0 then
3803		Info(InfoSimpcomp,1,"SCSeriesS2xS2: argument must be a non-negative integer.");
3804		return fail;
3805	fi;
3806	if k = 0 then
3807		return SCBdSimplex(5);
3808	fi;
3809	n:=6*k+6;
3810	dc:=[];
3811	Add(dc,[1,1,1,1,n-4]);
3812	Add(dc,[1,1,2*k+1,2*k+3,2*k]);
3813	Add(dc,[1,2*k+1,1,2*k+1,2*k+2]);
3814	Add(dc,[1,2*k+2,2*k+1,2,2*k]);
3815
3816	for i in [2..2*k] do
3817		Add(dc,[1,1,i,1,6*k+3-i]);
3818	od;
3819
3820	if IsOddInt(k) then
3821		Add(dc,[2*k+1,2,2*k+1,2*k,2]);
3822		for i in [0..k-2] do
3823			if IsOddInt(i) then
3824				Add(dc,[3*k-2*Int(i/2),2,3*k-2*Int((i+1)/2),2,2+2*i]);
3825			else
3826				Add(dc,[3*k-2*Int(i/2),2,3*k-2*Int((i+1)/2),2+2*i,2]);
3827			fi;
3828			Add(dc,[3*k-2*Int(i/2),3*k-2*Int((i+1)/2),2,2+2*i,2]);
3829		od;
3830	else
3831		Add(dc,[2*k+1,2,2*k+1,2,2*k]);
3832		for i in [0..k-2] do
3833			if IsOddInt(i) then
3834				Add(dc,[3*k-1-2*Int(i/2),2,3*k+1-2*Int((i+1)/2),2,2+2*i]);
3835			else
3836				Add(dc,[3*k-1-2*Int(i/2),2,3*k+1-2*Int((i+1)/2),2+2*i,2]);
3837			fi;
3838			Add(dc,[3*k-1-2*Int(i/2),3*k+1-2*Int((i+1)/2),2,2+2*i,2]);
3839		od;
3840	fi;
3841
3842	for i in [0..k-2] do
3843		Add(dc,[1,1,6*k-2*i,2,2+2*i]);
3844	od;
3845	str:=Concatenation("(S^2 x S^2)^(# ",String(k),")");
3846	c:=SCFromDifferenceCycles(dc);
3847	SetSCTopologicalType(c,str);
3848	SCRename(c,str);
3849	return c;
3850
3851end);
3852