################################################################## ################################################################## ################################################################## #### #### #### GAP-Program #### #### `MANIFOLD_VT' #### #### #### #### Version 04/02 #### #### by Frank H. Lutz, TU Berlin, Germany #### #### #### #### available at #### #### #### #### http://www.math.TU-Berlin.de/diskregeom/stellar/ #### #### #### #### (First Version 01/98 #### #### by Ekkehard G. Köhler, TU Berlin, Germany #### #### Frank H. Lutz, TU Berlin, Germany) #### #### #### ################################################################## ################################################################## ################################################################## ################################################################## ################################################################## ## ## ## The GAP-program MANIFOLD_VT generates, up to combinatorial ## ## equivalence, all (candidates for) vertex-transitive ## ## d-dimensional combinatorial manifolds and pseudomanifolds ## ## as well as all (candidates for) centrally symmetric ## ## combinatorial manifolds with dihedral or cyclic group action ## ## on n vertices if d and n are sufficiently small. ## ## ## ################################################################## ################################################################## ################################################################## ################################################################## ## ## ## How to use the program? ## ## ## ## (A) Install GAP on your computer. ## ## ## ## (B) GAP comprises a library of all vertex-transitive ## ## goup actions on n <= 23 vertices. ## ## The i-th transitive permutation group G of degree n ## ## of the corresponding list in the library ## ## is called by the command ## ## ## ## gap> G:=TransitiveGroup(n,i); ## ## ## ## (C) Adjust the following parameters: ## ## ## ################################################################## ################################################################## class_of_objects:=1; # <--- choose between # 1 = manifolds # 2 = centrally symmetric manifolds # with dihedral/cyclic action # 3 = pseudomanifolds # d:=2; # <--- fix the dimension vertices:=[16]; # <--- fix the set of vertices ################################################################## ################################################################## ## ## ## (D) Save the file MANIFOLD_VT. ## ## ## ## (E) Start GAP and call MANIFOLD_VT by the command ## ## ## ## gap> Read("MANIFOLD_VT"); ## ## ## ## (F) gap> quit; ## ## ## ## What is the output of the program? ## ## ## ## (G) If the program, in the case that class_of_objects = 1, ## ## finds a new candidate for a manifold, ## ## then it will print the facets of the simplicial complex ## ## (and the facets of the link of the vertex n if d > 3) ## ## to the file ## ## ## ## `d-manifolds_n.out' . ## ## ## ## Information, like the f-vector F, ## ## the Altshuler-Steinberg determinant det, ## ## representatives of the constituting orbits ## ## of the complex, and the sizes of the orbits ## ## will be printed to the file ## ## ## ## `d-manifolds_n.doc' . ## ## ## ## Every candidate gets a unique label ## ## ## ## complex_d_n_i_count . ## ## ## ## How to proceed further? ## ## ## ## (H) You can use the program `homology' by Frank Heckenbach ## ## to compute the homology of the candidates and ## ## of the corresponding links. ## ## The homology of a candidate has to obey ## ## Poincaré duality, the link must have the ## ## homology of a sphere. ## ## ## ## (I) Use the program `BISTELLAR' by A. Björner and F.H. Lutz ## ## to test if the link is a PL-sphere and thus the ## ## candidate a combinatorial manifold. ## ## ## ################################################################## ################################################################## ## ## ## For an exposition of the program MANIFOLD_VT ## ## (including the output to the screen) see the reference: ## ## ## ## F.H. Lutz. ## ## Triangulated Manifolds with Few Vertices and ## ## Vertex-Transitive Group Actions. ## ## Dissertation. Shaker Verlag, Aachen, 1999. ## ## ## ## Further references: ## ## ## ## A. Björner, F.H. Lutz. ## ## Simplicial manifolds, bistellar flips, ## ## and a 16-vertex triangulation of the ## ## Poincaré homology 3-sphere. ## ## Exp. Math. 9, 275-289 (2000); ## ## GAP-program `BISTELLAR', ## ## http://www.math.TU-Berlin.de/diskregeom/stellar/ ## ## ## ## F. Heckenbach. ## ## Die Möbiusfunktion und Homologien ## ## auf partiell geordneten Mengen, ## ## Thesis for Diploma at University Erlangen-Nuremberg, 1997; ## ## Computer program `Homology', ## ## http://www.mi.uni-erlangen.de/~heckenb/ ## ## ## ## The GAP Group. ## ## GAP -- Groups, Algorithms, and Programming, Version 4.2, ## ## Aachen, St Andrews, 2000, ## ## http://www-gap.dcs.st-and.ac.uk/~gap ## ## ## ################################################################## ################################################################## ################################################################## ################################################################## ### Defining variables and functions ### ################################################################## ################################################################## ### Global variables and functions ### n:=0; G:=0; i:=0; orbits_admissible:=[]; resultelement:=[]; flag_newcomplex:=0; faces:=[]; top_faces:=[]; link:=[]; lower_link:=[]; lower_link_dim:=0; lower_link_element:=[]; pivot:=[]; F:=[]; det:=0; det_link:=0; det_link_link:=[]; degree_link_link:=[]; complex_collection_large:=[]; complex_collection:=[]; count:=0; link_testset:=[]; flag_orientable:=0; Test_Connected:=[]; Test_EulerCharacteristic:=[]; Test_LowerLinks:=[]; Examine_Complex:=[]; file_doc:=0; file_out:=0; M:=0; flag_nearly:=0; #################################################################### ### Tests if Complex is Candidate for Manifold ### #################################################################### ### test: connected ### Test_Connected := function(ry) local component, k, flag_positive, intersection; component:=ShallowCopy(top_faces[1]); RemoveSet(top_faces,top_faces[1]); k:=0; flag_positive:=0; while k < Length(top_faces) and Length(component) < ry do k:=k+1; intersection:=ShallowCopy(top_faces[k]); IntersectSet(intersection,component); if not intersection = [] then UniteSet(component,top_faces[k]); RemoveSet(top_faces,top_faces[k]); k:=k-1; flag_positive:=1; fi; if k = Length(top_faces) and flag_positive = 1 then k:=0; flag_positive:=0; fi; od; if not Length(component) = ry then flag_newcomplex:=0; fi; end; ### test: strongly connected ### Test_StronglyConnected := function() local component, k, l, boundary, current_ridges, copy_current_ridges, ridge, flag_common_ridge; component:=[]; AddSet(component,top_faces[1]); l:=Length(top_faces[1])-1; boundary:=ShallowCopy(Combinations(top_faces[1],l)); RemoveSet(top_faces,top_faces[1]); k:=0; while k < Length(top_faces) do k:=k+1; current_ridges:=ShallowCopy(Combinations(top_faces[k],l)); copy_current_ridges:=ShallowCopy(current_ridges); flag_common_ridge:=0; for ridge in current_ridges do if ridge in boundary then RemoveSet(boundary,ridge); RemoveSet(copy_current_ridges,ridge); flag_common_ridge:=1; fi; od; if flag_common_ridge = 1 then AddSet(component,top_faces[k]); RemoveSet(top_faces,top_faces[k]); UniteSet(boundary,copy_current_ridges); k:=0; fi; od; if not Length(top_faces) = 0 then flag_newcomplex:=0; fi; end; ### test: Euler characteristic of sphere ### Test_EulerCharacteristic := function() local element, k, chi; if flag_newcomplex = 1 then for element in lower_link[lower_link_dim+1] do for k in [2..lower_link_dim] do UniteSet(lower_link[k],Combinations(element,k)); od; od; chi:=0; for k in [1..(lower_link_dim+1)] do chi:=chi+(-1)^(k+1)*Length(lower_link[k]); od; if not chi = 1+(-1)^lower_link_dim then flag_newcomplex:=0; fi; fi; end; ### test: lower links ### Test_LowerLinks := function(pivot) local pivot_face, k, element; for pivot_face in link[pivot] do if flag_newcomplex = 1 then lower_link:=[]; for k in [1..(d-pivot)] do lower_link[k]:=[]; od; for element in link[d] do if IsSubset(element,pivot_face) then lower_link_element:=ShallowCopy(element); SubtractSet(lower_link_element,pivot_face); AddSet(lower_link[d-pivot],lower_link_element); UniteSet(lower_link[1],Combinations(lower_link_element,1)); fi; od; top_faces:=ShallowCopy(lower_link[d-pivot]); Test_Connected(Length(lower_link[1])); lower_link_dim:=d-pivot-1; Test_EulerCharacteristic(); fi; od; end; ### test: examine resulting vertex-transitive closed complexes ### Examine_Complex := function() local r, k, element, linkelement, chi; # orbits of closed complex # faces:=[]; faces[d+1]:=[]; for r in resultelement do UniteSet(faces[d+1],orbits_admissible[d+1][r]); od; top_faces:=ShallowCopy(faces[d+1]); Test_StronglyConnected(); ### processing link ### if flag_newcomplex = 1 then link:=[]; for k in [1..d] do link[k]:=[]; od; for element in faces[d+1] do if n in element then linkelement:=ShallowCopy(element); RemoveSet(linkelement,n); AddSet(link[d],linkelement); UniteSet(link[1],Combinations(linkelement,1)); fi; od; top_faces:=ShallowCopy(link[d]); Test_Connected(Length(link[1])); ### test: link has euler characteristic of sphere ### if flag_newcomplex = 1 then for element in link[d] do for k in [2..(d-1)] do UniteSet(link[k],Combinations(element,k)); od; od; chi:=0; for k in [1..d] do chi:=chi+(-1)^(k+1)*Length(link[k]); od; if class_of_objects = 1 or class_of_objects = 2 then if not chi = 1+(-1)^(d-1) then flag_newcomplex:=0; fi; elif class_of_objects = 3 then if IsInt(d/2) = true then if not chi = 1+(-1)^(d-1) then flag_newcomplex:=0; fi; else if chi = 1+(-1)^(d-1) then # candidates for pseudo-manifolds # in odd dimensions with the link # having non-zero euler characteristic flag_newcomplex:=0; fi; fi; fi; fi; if d > 2 and flag_newcomplex = 1 then Test_LowerLinks(1); if d > 3 and flag_newcomplex = 1 then Test_LowerLinks(2); #if d > 4 and flag_newcomplex = 1 then # Test_LowerLinks(3); #fi; fi; fi; fi; end; #################################################################### ### Tests if Candidate Appeared Previously ### #################################################################### ### compute invariants ### ComputeInvariants := function() local k, element, matrixA, ii, jj, link_facets, link_vertices, copy_element; ### compute: Euler characteristic and Altshuler-Steinberg determinant ### F:=[]; for k in [1..d] do faces[k]:=[]; for element in faces[d+1] do UniteSet(faces[k],Combinations(element,k)); od; F[k]:=Length(faces[k]); od; F[d+1]:=Length(faces[d+1]); matrixA:=[]; for ii in [1..n] do matrixA[ii]:=[]; for jj in [1..Length(faces[d+1])] do if ii in faces[d+1][jj] then matrixA[ii][jj]:=1; else matrixA[ii][jj]:=0; fi; od; od; det:=DeterminantMat(matrixA*TransposedMat(matrixA)); ### compute determinants of link ### if d > 2 then det_link:=0; matrixA:=[]; for ii in [1..Length(link[1])] do matrixA[ii]:=[]; for jj in [1..Length(link[d])] do if link[1][ii][1] in link[d][jj] then matrixA[ii][jj]:=1; else matrixA[ii][jj]:=0; fi; od; od; det_link:=DeterminantMat(matrixA*TransposedMat(matrixA)); degree_link_link:=[]; det_link_link:=[]; for k in link[1] do link_facets:=[]; link_vertices:=[]; for element in link[d] do if k[1] in element then copy_element:=ShallowCopy(element); RemoveSet(copy_element,k[1]); AddSet(link_facets,copy_element); UniteSet(link_vertices,copy_element); fi; od; if d > 2 then degree_link_link[k[1]]:=Length(link_vertices); fi; if d > 3 then matrixA:=[]; for ii in [1..Length(link_vertices)] do matrixA[ii]:=[]; for jj in [1..Length(link_facets)] do if link_vertices[ii] in link_facets[jj] then matrixA[ii][jj]:=1; else matrixA[ii][jj]:=0; fi; od; od; det_link_link[k[1]]:=DeterminantMat(matrixA*TransposedMat(matrixA)); fi; od; fi; end; ### test: complex is multiplication-isomorphic to previous complex ### Test_MultiplicationIsomorphic := function() local complex_counter, flag_det_link, multiplication_element, collection_element_copy, element, element_copy, k, c; complex_counter:=0; if Length(complex_collection_large) > 0 then Print("test if equivalent to previous complex\n"); fi; while complex_counter < Length(complex_collection_large) do complex_counter:=complex_counter+1; if d > 2 then if det_link = complex_collection_large[complex_counter][4] then flag_det_link:=1; else flag_det_link:=0; fi; else flag_det_link:=1; fi; if F = complex_collection_large[complex_counter][2] and det = complex_collection_large[complex_counter][3] and flag_det_link = 1 then if faces[d+1] = complex_collection_large[complex_counter][1] then flag_newcomplex:=0; Print("IDENTICAL WITH PREVIOUS COMPLEX\n"); complex_counter:=Length(complex_collection_large); else for multiplication_element in [2..(n-1)] do if flag_newcomplex = 1 and Gcd(multiplication_element,n) = 1 then collection_element_copy:=[]; for element in complex_collection_large[complex_counter][1] do element_copy:=[]; for k in element do c:=multiplication_element*k; while c > n do c:=c-n; od; AddSet(element_copy,c); od; AddSet(collection_element_copy,element_copy); od; if faces[d+1] = collection_element_copy then flag_newcomplex:=0; Print("MULTIPLICATION-ISOMORPHIC TO PREVIOUS COMPLEX\n"); complex_counter:=Length(complex_collection_large); fi; fi; od; fi; fi; od; end; ### test: complex is equivalent to previous complex ### Test_Equivalent := function() local complex_counter, H, starA, element, starB, flag_det_link, stop_permutations, st, s, copyA, copyB, matched_verticesA, matched_verticesB, unmatched_verticesA, pairs, k, co_facesA, flag_mismatch, co_elementA, u, co_elementB, pair, new_vertexA, v, new_vertexB, intersection_co_facesA, permutedA, permuted_element; complex_counter:=0; while complex_counter < Length(complex_collection) do complex_counter:=complex_counter+1; if d > 2 then if det_link = complex_collection[complex_counter][5] and Set(degree_link_link) = Set(complex_collection[complex_counter][6]) then if d > 3 then if Set(det_link_link) = Set(complex_collection[complex_counter][7]) then flag_det_link:=1; else flag_det_link:=0; fi; else flag_det_link:=1; fi; else flag_det_link:=0; fi; else flag_det_link:=1; fi; if F = complex_collection[complex_counter][2] and det = complex_collection[complex_counter][3] and flag_det_link = 1 then H:=SymmetricGroup(d); starA:=[]; for element in faces[d+1] do if n in element then AddSet(starA,element); fi; od; starB:=ShallowCopy(complex_collection[complex_counter][4]); stop_permutations:=0; st:=0; while st < Length(starB) and stop_permutations = 0 do st:=st+1; s:=0; while s < Factorial(d) and stop_permutations = 0 do s:=s+1; flag_mismatch:=0; copyA:=ShallowCopy(faces[d+1]); copyB:=ShallowCopy(complex_collection[complex_counter][1]); RemoveSet(copyA,starA[1]); RemoveSet(copyB,starB[st]); matched_verticesA:=ShallowCopy(starA[1]); matched_verticesB:=ShallowCopy(starB[st]); unmatched_verticesA:=[1..n]; SubtractSet(unmatched_verticesA,starA[1]); pairs:=[]; for k in [1..d] do AddSet(pairs,[starA[1][k],starB[st][k^Elements(H)[s]]]); if d > 2 and not degree_link_link[starA[1][k]] = complex_collection[complex_counter][6][starB[st][k^Elements(H)[s]]] then flag_mismatch:=1; fi; if d > 3 and not det_link_link[starA[1][k]] = complex_collection[complex_counter][7][starB[st][k^Elements(H)[s]]] then flag_mismatch:=1; fi; od; AddSet(pairs,[n,n]); co_facesA:=ShallowCopy(Combinations(starA[1],d)); while Length(unmatched_verticesA) > 0 and flag_mismatch = 0 do co_elementA:=ShallowCopy(co_facesA[1]); u:=0; while u < Length(copyA) do u:=u+1; if IsSubset(copyA[u],co_elementA) then co_elementB:=[]; for pair in pairs do if pair[1] in co_elementA then AddSet(co_elementB,pair[2]); fi; od; new_vertexA:=ShallowCopy(copyA[u]); SubtractSet(new_vertexA,co_elementA); if new_vertexA[1] in unmatched_verticesA then v:=0; while v < Length(copyB) do v:=v+1; if IsSubset(copyB[v],co_elementB) then new_vertexB:=ShallowCopy(copyB[v]); SubtractSet(new_vertexB,co_elementB); if new_vertexB[1] in matched_verticesB then v:=Length(copyB); u:=Length(copyA); flag_mismatch:=1; else AddSet(pairs,[new_vertexA[1],new_vertexB[1]]); AddSet(matched_verticesA,new_vertexA[1]); AddSet(matched_verticesB,new_vertexB[1]); RemoveSet(unmatched_verticesA,new_vertexA[1]); UniteSet(co_facesA,Combinations(copyA[u],d)); RemoveSet(co_facesA,co_elementA); RemoveSet(copyA,copyA[u]); RemoveSet(copyB,copyB[v]); v:=Length(copyB); u:=Length(copyA); fi; fi; od; else for pair in pairs do if pair[1] = new_vertexA[1] then new_vertexB:=[pair[2]]; fi; od; AddSet(co_elementB,new_vertexB[1]); if co_elementB in copyB then intersection_co_facesA:=ShallowCopy(co_facesA); IntersectSet(intersection_co_facesA,Combinations(copyA[u],d)); UniteSet(co_facesA,Combinations(copyA[u],d)); SubtractSet(co_facesA,intersection_co_facesA); RemoveSet(copyA,copyA[u]); RemoveSet(copyB,co_elementB); u:=Length(copyA); else u:=Length(copyA); flag_mismatch:=1; fi; fi; fi; od; od; if unmatched_verticesA = [] then permutedA:=[]; for element in faces[d+1] do permuted_element:=[]; for k in element do AddSet(permuted_element,pairs[k][2]); od; AddSet(permutedA,permuted_element); od; if permutedA = complex_collection[complex_counter][1] then flag_newcomplex:=0; stop_permutations:=1; Print("EQUIVALENT TO PREVIOUS COMPLEX\n"); if d = 2 then AddSet(complex_collection_large,[faces[d+1],F,det]); else AddSet(complex_collection_large,[faces[d+1],F,det,det_link]); fi; complex_counter:=Length(complex_collection); fi; fi; od; od; fi; od; end; #################################################################### ### Output ### #################################################################### ### output complex ### OutputComplex := function() local star_orbit_collection, star_n, element, star_orbits, orbit, flag_neighborly, k; star_orbit_collection:=[]; star_n:=[]; for element in faces[d+1] do if n in element then AddSet(star_n,element); fi; od; star_orbits:=Orbits(Stabilizer(G,n),star_n,OnSets); for orbit in star_orbits do AddSet(star_orbit_collection,Set(orbit)[1]); od; if d = 2 then AddSet(complex_collection,[faces[d+1],F,det,star_orbit_collection]); AddSet(complex_collection_large,[faces[d+1],F,det]); elif d = 3 then AddSet(complex_collection,[faces[d+1],F,det,star_orbit_collection,det_link,degree_link_link]); AddSet(complex_collection_large,[faces[d+1],F,det,det_link]); else AddSet(complex_collection,[faces[d+1],F,det,star_orbit_collection,det_link,degree_link_link,det_link_link]); AddSet(complex_collection_large,[faces[d+1],F,det,det_link]); fi; flag_neighborly:=0; if Length(faces[2]) = Binomial(n,2) then Print("neighborly\n"); flag_neighborly:=1; fi; if d <= 3 then if class_of_objects = 1 or class_of_objects = 2 then Print("MANIFOLD\n"); elif class_of_objects = 3 then Print("PSEUDOMANIFOLD\n"); fi; else Print("CANDIDATE\n"); fi; count:=count+1; #Print(degree_link_link,"\n"); #if d > 3 then # Print(det_link_link,"\n"); #fi; if d <= 3 then if class_of_objects = 1 then AppendTo(file_out,"manifold_",d,"_",n,"_",i,"_",count,"=",faces[d+1],"\n\n"); elif class_of_objects = 2 then AppendTo(file_out,"cs_manifold_",d,"_",n,"_",i,"_",count,"=",faces[d+1],"\n\n"); elif class_of_objects = 3 then AppendTo(file_out,"pseudomanifold_",d,"_",n,"_",i,"_",count,"=",faces[d+1],"\n\n"); AppendTo(file_out,"___link_",d,"_",n,"_",i,"_",count,"=",link[d],"\n\n"); fi; else AppendTo(file_out,"complex_",d,"_",n,"_",i,"_",count,"=",faces[d+1],"\n\n"); AppendTo(file_out,"___link_",d,"_",n,"_",i,"_",count,"=",link[d],"\n\n"); fi; if count = 1 then AppendTo(file_doc,"\n"); fi; AppendTo(file_doc,"count = ",count,"\n"); AppendTo(file_doc," f = ",F,"\n"); AppendTo(file_doc," det = ",det,"\n"); if d > 2 then AppendTo(file_doc," det_link = ",det_link,"\n"); fi; if flag_neighborly = 1 then AppendTo(file_doc," neighborly\n"); fi; if flag_nearly = 1 then AppendTo(file_doc," nearly neighborly if sphere\n"); fi; AppendTo(file_doc," stack = ",resultelement,"\n"); AppendTo(file_doc," orbits = "); for k in resultelement do AppendTo(file_doc,Length(orbits_admissible[d+1][k])," ",orbits_admissible[d+1][k][1]," "); od; AppendTo(file_doc,"\n\n"); end; #################################################################### ### Test if Subset of Link of Complex is Orientable ### #################################################################### ### test: subset of link orientable ### Test_Orientable := function() local boundary, j, copy_facet, position, neighbors, boundary1, boundary2, neighbor; while Length(link_testset) > 0 and flag_orientable = 1 do boundary:=[]; for j in [1..d] do copy_facet:=ShallowCopy(link_testset[1]); RemoveSet(copy_facet,copy_facet[j]); AddSet(boundary,[copy_facet,(-1)^j]); od; RemoveSet(link_testset,link_testset[1]); position:=1; while position <= Length(link_testset) and flag_orientable = 1 do neighbors:=[[],[]]; boundary1:=[]; boundary2:=[]; for j in [1..d] do copy_facet:=ShallowCopy(link_testset[position]); RemoveSet(copy_facet,copy_facet[j]); AddSet(boundary1,[copy_facet,(-1)^j]); if [copy_facet,(-1)^j] in boundary then AddSet(neighbors[1],[copy_facet,(-1)^j]); fi; AddSet(boundary2,[copy_facet,(-1)^(j+1)]); if [copy_facet,(-1)^(j+1)] in boundary then AddSet(neighbors[2],[copy_facet,(-1)^(j+1)]); fi; od; if Length(neighbors[1]) > 0 and Length(neighbors[2]) > 0 then flag_orientable:=0; elif Length(neighbors[1]) > 0 then for neighbor in neighbors[1] do RemoveSet(boundary2,[neighbor[1],(-1)*neighbor[2]]); od; SubtractSet(boundary,neighbors[1]); UniteSet(boundary,boundary2); RemoveSet(link_testset,link_testset[position]); position:=1; elif Length(neighbors[2]) > 0 then for neighbor in neighbors[2] do RemoveSet(boundary1,[neighbor[1],(-1)*neighbor[2]]); od; SubtractSet(boundary,neighbors[2]); UniteSet(boundary,boundary1); RemoveSet(link_testset,link_testset[position]); position:=1; else position:=position+1; fi; od; od; end; #################################################################### ### Test: nearly neighborly ### #################################################################### Test_NearlyNeighborly := function() local k, element, edges, matching, vertex_pairs, copy_faces, copy_element; flag_nearly:=1; if IsInt(F[1]/2) = true then for k in [1..Int((d-1)/2)] do if not F[k+1]=2^(k+1)*Binomial(F[1]/2,k+1) then flag_nearly:=0; fi; od; if flag_nearly = 1 then edges:=Combinations([1..n],2); SubtractSet(edges,faces[2]); matching:=[]; for element in edges do UniteSet(matching,element); od; if Length(matching) = F[1] then vertex_pairs:=[]; for element in edges do AddSet(vertex_pairs,[element[1],element[2]]); AddSet(vertex_pairs,[element[2],element[1]]); od; copy_faces:=[]; for element in faces[d+1] do copy_element:=[]; for k in element do AddSet(copy_element,vertex_pairs[k][2]); od; AddSet(copy_faces,copy_element); od; if not copy_faces = faces[d+1] then flag_nearly:=0; fi; else flag_nearly:=0; fi; fi; else flag_nearly:=0; fi; end; ################################################################### ################################################################### ### Main Part ### ################################################################### ################################################################### if class_of_objects = 1 or class_of_objects = 3 then group_list:=[[1,1],[2,1],[3,2],[4,5],[5,5], [6,16],[7,7],[8,50],[9,34],[10,45], [11,8],[12,301],[13,9],[14,63],[15,104], [16,1954],[17,10],[18,983],[19,8],[20,1117], [21,164],[22,59],[23,7]]; elif class_of_objects = 2 then Grp:=[]; for n in [6,8,10,12,14,16,18,20,22,24] do Grp[n]:=[]; od; Grp[6][1]:=Group((1,2,3,4,5,6)); Grp[6][2]:=Group((1,2,3,4,5,6),(1,6)(2,5)(3,4)); Grp[8][1]:=Group((1,2,3,4,5,6,7,8)); Grp[8][2]:=Group((1,2,3,4,5,6,7,8),(1,8)(2,7)(3,6)(4,5)); Grp[10][1]:=Group((1,2,3,4,5,6,7,8,9,10)); Grp[10][2]:=Group((1,2,3,4,5,6,7,8,9,10),(1,10)(2,9)(3,8)(4,7)(5,6)); Grp[12][1]:=Group((1,2,3,4,5,6,7,8,9,10,11,12)); Grp[12][2]:=Group((1,2,3,4,5,6,7,8,9,10,11,12), (1,12)(2,11)(3,10)(4,9)(5,8)(6,7)); Grp[14][1]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14)); Grp[14][2]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14), (1,14)(2,13)(3,12)(4,11)(5,10)(6,9)(7,8)); Grp[16][1]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)); Grp[16][2]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16), (1,16)(2,15)(3,14)(4,13)(5,12)(6,11)(7,10)(8,9)); Grp[18][1]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18)); Grp[18][2]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18), (1,18)(2,17)(3,16)(4,15)(5,14)(6,13)(7,12)(8,11)(9,10)); Grp[20][1]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)); Grp[20][2]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20), (1,20)(2,19)(3,18)(4,17)(5,16)(6,15)(7,14)(8,13)(9,12)(10,11)); Grp[22][1]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22)); Grp[22][2]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22), (1,22)(2,21)(3,20)(4,19)(5,18)(6,17)(7,16)(8,15)(9,14)(10,13)(11,12)); Grp[24][1]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24)); Grp[24][2]:=Group((1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24), (1,24)(2,23)(3,22)(4,21)(5,20)(6,19)(7,18)(8,17)(9,16)(10,15)(11,14)(12,13)); fi; for n in vertices do complex_collection:=[]; complex_collection_large:=[]; if class_of_objects = 1 then file_doc:=Concatenation(String(d),"-manifolds_",String(n),".doc"); file_out:=Concatenation(String(d),"-manifolds_",String(n),".out"); Print("\n",d,"-manifolds on ",n," vertices with transitive automorphism group\n\n\n"); PrintTo(file_doc,"\n",d,"-manifolds on ",n," vertices with transitive automorphism group\n\n\n"); PrintTo(file_out,"\n"); elif class_of_objects = 2 then file_doc:=Concatenation(String(d),"-manifolds-cs_",String(n),".doc"); file_out:=Concatenation(String(d),"-manifolds-cs_",String(n),".out"); Print("\n","Centrally symmetric ",d,"-manifolds on ",n," vertices with dihedral/cyclic automorphism group\n\n\n"); PrintTo(file_doc,"\n",d,"-manifolds on ",n," vertices with dihedral/cyclic automorphism group\n\n\n"); PrintTo(file_out,"\n"); elif class_of_objects = 3 then file_doc:=Concatenation(String(d),"-pseudo-manifolds_",String(n),".doc"); file_out:=Concatenation(String(d),"-pseudo-manifolds_",String(n),".out"); Print("\n",d,"-pseudo-manifolds on ",n," vertices with transitive automorphism group\n\n\n"); PrintTo(file_doc,d,"-pseudo-manifolds on ",n," vertices with transitive automorphism group\n\n\n"); PrintTo(file_out,"\n"); fi; if class_of_objects = 1 then if IsInt((d-1)/2) = true then M:=Binomial((n-1)-Int(d/2)-1,Int(d/2))+Binomial((n-1)-1-(d-1)/2,(d-1)/2); else M:=Binomial((n-1)-d/2,d/2)+Binomial((n-1)-1-Int((d-1)/2)-1,Int((d-1)/2)); fi; elif class_of_objects = 2 then FN:=[]; for k in [0..Int((d-1-1)/2)] do FN[k+1]:=2^(k+1)*Binomial(n/2-1,k+1); od; h:=[]; for k in [1..Int((d-1+1)/2)] do h[k]:=(-1)^k*Binomial(d-1+1,k); for i in [1..k] do h[k]:=h[k]+(-1)^(k-i)*Binomial(d-1+1-i,d-1+1-k)*FN[i]; od; od; for k in [(Int((d-1+1)/2)+1)..(d-1)] do h[k]:=h[d-1+1-k]; od; h[d-1+1]:=1; for k in [(Int((d-1-1)/2)+1)..(d-1)] do FN[k+1]:=Binomial(d-1+1,k+1); for j in [1..(k+1)] do FN[k+1]:=FN[k+1]+Binomial(d-1+1-j,k+1-j)*h[j]; od; od; M:=FN[d]; elif class_of_objects = 3 then if d = 4 then M:=Binomial((n-1)-d/2,d/2)+Binomial((n-1)-1-Int((d-1)/2)-1,Int((d-1)/2)); else M:=Binomial(n-1,d); fi; fi; if class_of_objects = 1 or class_of_objects = 3 then i:=group_list[n][2]; elif class_of_objects = 2 then i:=2; fi; while i > 0 do # <--- can be altered to exclude groups of small order ### determining admissible orbits ### if class_of_objects = 1 or class_of_objects = 3 then G:=TransitiveGroup(n,i); elif class_of_objects = 2 then G:=Grp[n][i]; fi; count:=0; sets:=[]; orbits:=[]; for k in [d..(d+1)] do sets[k]:=Combinations([1..n],k); orbits[k]:=Orbits(G,sets[k],OnSets); od; orbits_admissible:=[]; orbits_admissible[d+1]:=[]; for orbit in orbits[d+1] do if class_of_objects = 1 or class_of_objects = 3 then AddSet(orbits_admissible[d+1],Set(orbit)); elif class_of_objects = 2 then flag_match:=1; for a in [1..d] do for b in [(a+1)..(d+1)] do if Set(orbit)[1][b]-Set(orbit)[1][a] = n/2 then flag_match:=0; fi; od; od; if flag_match = 1 then AddSet(orbits_admissible[d+1],Set(orbit)); fi; fi; od; orbits_forbidden:=[]; ### test: pseudomanifold property for orbits ### orbits_forbidden[d+1]:=[]; for lower in orbits[d] do for upper in orbits_admissible[d+1] do number:=0; for element in upper do if IsSubset(element,lower[1]) then number:=number+1; fi; od; if number >= 3 then AddSet(orbits_forbidden[d+1],upper); fi; od; od; SubtractSet(orbits_admissible[d+1],orbits_forbidden[d+1]); ### test: link orientable and bounded in size ### if d > 2 then orbits_forbidden[d+1]:=[]; for upper in orbits_admissible[d+1] do link_testset:=[]; for element in upper do if n in element then copy_element:=ShallowCopy(element); RemoveSet(copy_element,n); AddSet(link_testset,copy_element); fi; od; if Length(link_testset) > M then AddSet(orbits_forbidden[d+1],upper); elif class_of_objects = 1 or class_of_objects = 2 then flag_orientable:=1; Test_Orientable(); if flag_orientable = 0 then AddSet(orbits_forbidden[d+1],upper); fi; fi; od; SubtractSet(orbits_admissible[d+1],orbits_forbidden[d+1]); fi; ### remove unmatchable orbits ### flag_forbidden:=1; while flag_forbidden = 1 do orbits_forbidden[d+1]:=[]; for lower in orbits[d] do number:=0; for upper in orbits_admissible[d+1] do for element in upper do if IsSubset(element,lower[1]) then number:=number+1; upper_candidate:=ShallowCopy(upper); fi; od; od; if number = 1 then AddSet(orbits_forbidden[d+1],upper_candidate); fi; od; if not orbits_forbidden[d+1] = [] then SubtractSet(orbits_admissible[d+1],orbits_forbidden[d+1]); else flag_forbidden:=0; fi; od; orbits_admissible[d]:=[]; for lower in orbits[d] do number:=0; for upper in orbits_admissible[d+1] do for element in upper do if IsSubset(element,lower[1]) then number:=number+1; fi; od; od; if number > 0 then AddSet(orbits_admissible[d],Set(lower)); fi; od; all:=Length(orbits[d+1]); up:=Length(orbits_admissible[d+1]); low:=Length(orbits_admissible[d]); Print("n",n," #",i," all ",all," up ",up," low ",low,"\n"); AppendTo(file_doc,"n",n," #",i," all ",all," up ",up," low ",low,"\n"); ### computing matrix ### matrix:=[]; if d > 2 then orbit_link:=[]; fi; for r in [1..up] do matrix[r]:=[]; for s in [1..low] do number:=0; for element in orbits_admissible[d+1][r] do if IsSubset(element,orbits_admissible[d][s][1]) then number:=number+1; fi; od; if number > 0 then AddSet(matrix[r],[s,number]); fi; od; if d > 2 then orbit_link[r]:=((d+1)*Length(orbits_admissible[d+1][r]))/n; fi; od; Print("matrix is complete\n\n"); ### computing combinations of row vectors ### length_resultlist:=0; newrows:=[1..up]; column:=[]; for s in [1..low] do column[s]:=[]; od; single_resultorbits:=[]; for ru in [1..up] do flag_result:=1; for element in matrix[ru] do if element[2] = 1 then flag_result:=0; fi; od; if flag_result = 1 then resultelement:=[ru]; flag_newcomplex:=1; Examine_Complex(); if flag_newcomplex = 1 then AddSet(single_resultorbits,resultelement); length_resultlist:=length_resultlist+1; fi; RemoveSet(newrows,ru); else AddSet(column[matrix[ru][1][1]],ru); fi; od; nr:=Length(newrows); if nr > 1 then vectorsum:=[]; for s in [1..(low+2)] do vectorsum[s]:=0; od; current_element:=[newrows[1]]; for tuple in matrix[newrows[1]] do vectorsum[tuple[1]]:=vectorsum[tuple[1]]+tuple[2]; if vectorsum[tuple[1]] = 1 then vectorsum[low+1]:=vectorsum[low+1]+1; fi; od; if d > 2 then vectorsum[low+2]:=vectorsum[low+2]+orbit_link[newrows[1]]; fi; column_position:=matrix[newrows[1]][1][1]; current_position:=Position(column[column_position],newrows[1])+1; stop_flag:=0; while stop_flag = 0 do flag_result:=0; while flag_result = 0 and column_position <= low do if current_position <= Length(column[column_position]) then if vectorsum[column_position] = 2 then column_position:=column_position+1; current_position:=1; elif vectorsum[column_position] = 0 and matrix[column[column_position][current_position]][1][2] = 1 and current_position = Length(column[column_position]) then column_position:=column_position+1; current_position:=1; else flag_result:=1; illegal_sum:=0; for tuple in matrix[column[column_position][current_position]] do vectorsum[tuple[1]]:=vectorsum[tuple[1]]+tuple[2]; if vectorsum[tuple[1]] >= 3 then illegal_sum:=1; elif vectorsum[tuple[1]] = 2 and tuple[2] = 1 then vectorsum[low+1]:=vectorsum[low+1]-1; elif vectorsum[tuple[1]] = 1 then vectorsum[low+1]:=vectorsum[low+1]+1; fi; od; ### test: link bounded in size ### if illegal_sum = 0 and d > 2 then vectorsum[low+2]:=vectorsum[low+2]+orbit_link[column[column_position][current_position]]; if vectorsum[low+2] > M then illegal_sum:=1; vectorsum[low+2]:=vectorsum[low+2]-orbit_link[column[column_position][current_position]]; fi; fi; if illegal_sum = 0 then AddSet(current_element,column[column_position][current_position]); if vectorsum[low+1] = 0 then if Length(single_resultorbits) > 0 then if single_resultorbits[1][1] <= current_element[1] then flag_single:=1; else flag_single:=0; fi; while flag_single = 1 do resultelement:=ShallowCopy(single_resultorbits[1]); Print("closed ",resultelement,"\n"); RemoveSet(single_resultorbits,single_resultorbits[1]); flag_newcomplex:=1; Examine_Complex(); if flag_newcomplex = 1 then ComputeInvariants(); Test_MultiplicationIsomorphic(); if flag_newcomplex = 1 then Test_Equivalent(); if flag_newcomplex = 1 then if class_of_objects = 2 then flag_nearly:=1; Test_NearlyNeighborly(); fi; OutputComplex(); fi; fi; fi; if Length(single_resultorbits) > 0 then if single_resultorbits[1][1] <= current_element[1] then flag_single:=1; else flag_single:=0; fi; else flag_single:=0; fi; od; fi; resultelement:=ShallowCopy(current_element); Print("closed ",resultelement,"\n"); flag_newcomplex:=1; Examine_Complex(); if flag_newcomplex = 1 then ComputeInvariants(); Test_MultiplicationIsomorphic(); if flag_newcomplex = 1 then Test_Equivalent(); if flag_newcomplex = 1 then if class_of_objects = 2 then flag_nearly:=1; Test_NearlyNeighborly(); fi; OutputComplex(); fi; fi; fi; length_resultlist:=length_resultlist+1; if length_resultlist > 0 and IsInt(length_resultlist/100) then Print(length_resultlist,"\n"); fi; else flag_result:=0; fi; else flag_result:=0; for tuple in matrix[column[column_position][current_position]] do if vectorsum[tuple[1]] = 2 and tuple[2] = 1 then vectorsum[low+1]:=vectorsum[low+1]+1; elif vectorsum[tuple[1]] = 1 then vectorsum[low+1]:=vectorsum[low+1]-1; fi; vectorsum[tuple[1]]:=vectorsum[tuple[1]]-tuple[2]; od; fi; current_position:=current_position+1; fi; else if vectorsum[column_position] in [0,2] then column_position:=column_position+1; current_position:=1; else current_row:=current_element[Length(current_element)]; for tuple in matrix[current_row] do if vectorsum[tuple[1]] = 2 and tuple[2] = 1 then vectorsum[low+1]:=vectorsum[low+1]+1; elif vectorsum[tuple[1]] = 1 then vectorsum[low+1]:=vectorsum[low+1]-1; fi; vectorsum[tuple[1]]:=vectorsum[tuple[1]]-tuple[2]; od; if d > 2 then vectorsum[low+2]:=vectorsum[low+2]-orbit_link[current_row]; fi; RemoveSet(current_element,current_row); if current_element = [] and column_position > low then stop_flag:=1; fi; column_position:=matrix[current_row][1][1]; current_position:=Position(column[column_position],current_row)+1; fi; fi; od; if current_element = [] and column_position > low then stop_flag:=1; else current_row:=current_element[Length(current_element)]; for tuple in matrix[current_row] do if vectorsum[tuple[1]] = 2 and tuple[2] = 1 then vectorsum[low+1]:=vectorsum[low+1]+1; elif vectorsum[tuple[1]] = 1 then vectorsum[low+1]:=vectorsum[low+1]-1; fi; vectorsum[tuple[1]]:=vectorsum[tuple[1]]-tuple[2]; od; if d > 2 then vectorsum[low+2]:=vectorsum[low+2]-orbit_link[current_row]; fi; RemoveSet(current_element,current_row); column_position:=matrix[current_row][1][1]; current_position:=Position(column[column_position],current_row)+1; fi; od; fi; while Length(single_resultorbits) > 0 do resultelement:=ShallowCopy(single_resultorbits[1]); Print("closed ",resultelement,"\n"); RemoveSet(single_resultorbits,single_resultorbits[1]); flag_newcomplex:=1; Examine_Complex(); if flag_newcomplex = 1 then ComputeInvariants(); Test_MultiplicationIsomorphic(); if flag_newcomplex = 1 then Test_Equivalent(); if flag_newcomplex = 1 then if class_of_objects = 2 then flag_nearly:=1; Test_NearlyNeighborly(); fi; OutputComplex(); fi; fi; fi; od; Print("\n","results = ",length_resultlist,"\n"); AppendTo(file_doc,"\n","results = ",length_resultlist,"\n"); Print("\n\n\n\n"); AppendTo(file_doc,"\n\n\n\n"); GASMAN("collect"); i:=i-1; od; Print("\n\n"); AppendTo(file_doc,"END\n"); od;