Hyperbolic Honeycombs

Helper

PlusMinus[v_]:=Union[{{v[[1]],v[[2]],v[[3]]},{v[[1]],v[[2]],-v[[3]]},{v[[1]],-v[[2]],v[[3]]},{v[[1]],-v[[2]],-v[[3]]},{-v[[1]],v[[2]],v[[3]]},{-v[[1]],v[[2]],-v[[3]]},{-v[[1]],-v[[2]],v[[3]]},{-v[[1]],-v[[2]],-v[[3]]}}]
EvenPermutationsHyperboloid[v_]:=Module[{},Union[{v,{v[[1]],v[[3]],v[[4]],v[[2]]},{v[[1]],v[[4]],v[[2]],v[[3]]}}]]
EvenPermutationsKlein[v_]:=Module[{},Union[{v,{v[[2]],v[[3]],v[[1]]},{v[[3]],v[[1]],v[[2]]}}]]
KleinToHyperboloid[v_]:=Module[{norm=(Sqrt[1-((v[[1]])^2)-((v[[2]])^2)-((v[[3]])^2)])},{1/norm,v[[1]]/norm,v[[2]]/norm,v[[3]]/norm}]
HyperboloidToKlein[v_]:=Module[{},{((v[[2]])/(v[[1]])),((v[[3]])/(v[[1]])),((v[[4]])/(v[[1]]))}]
DistanceHyperboloid[u_,v_]:=u[[1]]v[[1]]-u[[2]]v[[2]]-u[[3]]v[[3]]-u[[4]]v[[4]];
OneOutOf24:=(#[[2]]≥0&&#[[3]]≥0&&#[[4]]≥0&&#[[2]]≥#[[3]]&&#[[2]]≥#[[4]])&

Vertex-centered {5,3,4}

ϕ=GoldenRatio;
coshEdge=ϕ;
vertices={{0,0,0},{1,0,0},{1,(1/ϕ),0},{1,(1/ϕ),(1/(ϕ^2))},{(ϕ/2),(ϕ/2),(1/2)},{(ϕ/(Sqrt[5])),(ϕ/(Sqrt[5])),(ϕ/(Sqrt[5]))},
{(2/ϕ),0,0},{(2/ϕ),(1/(ϕ^3)),0},{((ϕ^2)/(Sqrt[5])),(1/(Sqrt[5])),0},{(2/ϕ),(1/(ϕ^3)),(1/(ϕ^4))},{((Sqrt[5])/2),(1/2),(1/(2ϕ))},{((ϕ^2)/(Sqrt[5])),(1/(Sqrt[5])),(1/((Sqrt[5])(ϕ^2)))},{(((Sqrt[5])ϕ)/3),(1/3),(1/(3ϕ))},{(3/(ϕ^2)),(1/(ϕ^2)),(1/(ϕ^2))},{((ϕ^2)/2)-(1/(2(ϕ^3))),(1/(2ϕ)),(1/(2ϕ))},
{1,(2/(ϕ^2)),0},{1,(2/(ϕ^2)),(1/(ϕ^4))},{(2/(Sqrt[5])),(2/(Sqrt[5])),0},{1,(ϕ/(Sqrt[5])),(1/((Sqrt[5])ϕ))},{(((Sqrt[5])(ϕ^3))/((ϕ^5)-1)),((2(ϕ^3))/((ϕ^5)-1)),(ϕ/((ϕ^5)-1))},{(2/(Sqrt[5])),(2/(Sqrt[5])),(1/((Sqrt[5])(ϕ^3)))},{((Sqrt[5])/(ϕ^2)),((Sqrt[5])/(ϕ^2)),(1/(ϕ^2))},{(3/(2ϕ)),(ϕ/2),(1/(2ϕ))},{1-(1/(ϕ^5)),((Sqrt[5])/(ϕ^2)),(1/(ϕ^3))},
{1,(1/ϕ),(2/(ϕ^3))},{(((Sqrt[5])(ϕ^3))/((ϕ^5)-1)),((ϕ^4)/((ϕ^5)-1)),((2(ϕ^2))/((ϕ^5)-1))},{1,(2/((Sqrt[5])ϕ)),(2/((Sqrt[5])ϕ))},{((ϕ^2)/3),(ϕ/3),((Sqrt[5])/3)},{((2(ϕ^3))/((ϕ^5)-2)),(((Sqrt[5])(ϕ^2))/((ϕ^5)-2)),((2(ϕ^2))/((ϕ^5)-2))},{((2(ϕ^3))/((ϕ^4)+2)),((2(ϕ^2))/((ϕ^4)+2)),((2(ϕ^2))/((ϕ^4)+2))},{(ϕ/2),((Sqrt[5])/(2ϕ)),((Sqrt[5])/(2ϕ))},{((Sqrt[5])/(ϕ^2)),(3/(ϕ^3)),(1/ϕ)},{(2/(Sqrt[5])),(ϕ/(Sqrt[5]))-(1/((Sqrt[5])(ϕ^4))),(1/ϕ)}
} (1/(Sqrt[ϕ]));
edges={};
(* Create all permutations of vertices *)
vertices=Flatten[Map[(Permutations[#])&,vertices],1];
(* Add plus or minus signs *)
vertices=Flatten[Map[PlusMinus,vertices],1];
Print["Number of vertices is:"]
Print[Length[vertices]]
(* Numerical *)
vertices = vertices 1.0;
verticesHyperboloid=Map[KleinToHyperboloid,vertices];
Print["Generating edges. Please wait..."]
For[i=1,i≤Length[vertices],i++,
For[j=i+1,j≤Length[vertices],j++,
If[vertices[[i,1]]vertices[[j,1]]≥0&&vertices[[i,2]]vertices[[j,2]]≥0&&vertices[[i,3]]vertices[[j,3]]≥0,
distance=DistanceHyperboloid[verticesHyperboloid[[i]],verticesHyperboloid[[j]]];
If[distance>1.01coshEdge,
(* no edge *),
If[distance<0.99 coshEdge,
(* Error! *)
Print["Error"],
AppendTo[edges,{i,j,3(1-Norm[((vertices[[i]]+vertices[[j]])/2)])}]]]]]]
Print["Number of edges is:"]
Print[Length[edges]]

Graphics3D[{Table[Line[{vertices[[edges[[i,1]]]],vertices[[edges[[i,2]]]]},VertexColors->{Hue[edges[[i,3]]],Hue[edges[[i,3]]]}],{i,1,Length[edges]}]},Boxed->False,ViewPoint->{2,2,3},ViewVertical->{1,0,0},ImageSize->600]

From vertex first to cell first

ϕ=GoldenRatio;
cellCenterToVertex=(({{1, 0, 0, 0}, {0, (1/(Sqrt[2])), -(1/(Sqrt[2])), 0}, {0, (1/(Sqrt[2])), (1/(Sqrt[2])), 0}, {0, 0, 0, 1}})).(({{Cosh[d3], 0, 0, Sinh[d3]}, {0, 1, 0, 0}, {0, 0, 1, 0}, {Sinh[d3], 0, 0, Cosh[d3]}})).(({{Cosh[d1], Sinh[d1], 0, 0}, {Sinh[d1], Cosh[d1], 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}))((Sqrt[(2/ϕ)]))/.{d3->ArcTanh[(ϕ^(-3/2))],d1->ArcCosh[ϕ]}//FullSimplify;
cellCenterToVertex//MatrixForm;
vertices={{0,0,0},{1,0,0},{1,(1/ϕ),0},{1,(1/ϕ),(1/(ϕ^2))},{(ϕ/2),(ϕ/2),(1/2)},{(ϕ/(Sqrt[5])),(ϕ/(Sqrt[5])),(ϕ/(Sqrt[5]))},
{(2/ϕ),0,0},{(2/ϕ),(1/(ϕ^3)),0},{((ϕ^2)/(Sqrt[5])),(1/(Sqrt[5])),0},{(2/ϕ),(1/(ϕ^3)),(1/(ϕ^4))},{((Sqrt[5])/2),(1/2),(1/(2ϕ))},{((ϕ^2)/(Sqrt[5])),(1/(Sqrt[5])),(1/((Sqrt[5])(ϕ^2)))},{(((Sqrt[5])ϕ)/3),(1/3),(1/(3ϕ))},{(3/(ϕ^2)),(1/(ϕ^2)),(1/(ϕ^2))},{((ϕ^2)/2)-(1/(2(ϕ^3))),(1/(2ϕ)),(1/(2ϕ))},
{1,(2/(ϕ^2)),0},{1,(2/(ϕ^2)),(1/(ϕ^4))},{(2/(Sqrt[5])),(2/(Sqrt[5])),0},{1,(ϕ/(Sqrt[5])),(1/((Sqrt[5])ϕ))},{(((Sqrt[5])(ϕ^3))/((ϕ^5)-1)),((2(ϕ^3))/((ϕ^5)-1)),(ϕ/((ϕ^5)-1))},{(2/(Sqrt[5])),(2/(Sqrt[5])),(1/((Sqrt[5])(ϕ^3)))},{((Sqrt[5])/(ϕ^2)),((Sqrt[5])/(ϕ^2)),(1/(ϕ^2))},{(3/(2ϕ)),(ϕ/2),(1/(2ϕ))},{1-(1/(ϕ^5)),((Sqrt[5])/(ϕ^2)),(1/(ϕ^3))},
{1,(1/ϕ),(2/(ϕ^3))},{(((Sqrt[5])(ϕ^3))/((ϕ^5)-1)),((ϕ^4)/((ϕ^5)-1)),((2(ϕ^2))/((ϕ^5)-1))},{1,(2/((Sqrt[5])ϕ)),(2/((Sqrt[5])ϕ))},{((ϕ^2)/3),(ϕ/3),((Sqrt[5])/3)},{((2(ϕ^3))/((ϕ^5)-2)),(((Sqrt[5])(ϕ^2))/((ϕ^5)-2)),((2(ϕ^2))/((ϕ^5)-2))},{((2(ϕ^3))/((ϕ^4)+2)),((2(ϕ^2))/((ϕ^4)+2)),((2(ϕ^2))/((ϕ^4)+2))},{(ϕ/2),((Sqrt[5])/(2ϕ)),((Sqrt[5])/(2ϕ))},{((Sqrt[5])/(ϕ^2)),(3/(ϕ^3)),(1/ϕ)},{(2/(Sqrt[5])),(ϕ/(Sqrt[5]))-(1/((Sqrt[5])(ϕ^4))),(1/ϕ)}
} (1/(Sqrt[ϕ]));
edges={};
(* Create all permutations of vertices *)
vertices=Flatten[Map[(Permutations[#])&,vertices],1];
(* Add plus or minus signs *)
vertices=Flatten[Map[PlusMinus,vertices],1];
(* Numerical *)
vertices=N[vertices];
verticesHyperboloid=Map[KleinToHyperboloid,vertices];
newVertices=Simplify[Table[verticesHyperboloid[[i]].cellCenterToVertex ,{i,1,Length[verticesHyperboloid]}]];
newVertices=SortBy[Select[newVertices,(#[[2]]≥0&&#[[3]]≥0&&#[[4]]≥0&&#[[2]]≥#[[3]]&&#[[2]]≥#[[4]])&],First];
Length[newVertices]

MatrixForm[newVertices[[Table[i,{i,1,17}]]]]

Cell-centered {5,3,4}. R=(Sqrt[2/ϕ])

ϕ=GoldenRatio;
coshEdge=ϕ;
(* Starting from hyperboloid model *)
verticesHyperboloid={{(ϕ^(3/2)),1,1,1},{(ϕ^(3/2)),ϕ,0,(1/ϕ)},
{(Sqrt[5])(ϕ^(3/2)),2ϕ,(ϕ^2),ϕ},{(Sqrt[5])(ϕ^(3/2)),(Sqrt[5])ϕ,0,(ϕ^2)},{(Sqrt[5])(ϕ^(3/2)),(ϕ^3),1,1},
{3 (ϕ^(3/2)),(ϕ^3),(ϕ^3),1},{3 (ϕ^(3/2)),2(ϕ^2),(ϕ^2),ϕ},{3 (ϕ^(3/2)),(Sqrt[5])(ϕ^2),ϕ,0},
{(ϕ^(9/2)),(ϕ^4)+(1/ϕ),(ϕ^3),1},{(ϕ^(9/2)),3 (ϕ^2),(Sqrt[5])ϕ,0},{(ϕ^(9/2)),(ϕ^4),2(ϕ^2),(1/ϕ)}
(*{(ϕ^(9/2)),(Sqrt[5])(ϕ^2),(Sqrt[5])ϕ,2(ϕ^2)},{(ϕ^(9/2)),(ϕ^3)+2,(ϕ^3),(ϕ^3)},{(ϕ^(9/2)),(ϕ^4)+(1/ϕ),1,(ϕ^3)},{(ϕ^(9/2)),2 (ϕ^3),(1/ϕ),ϕ},{(ϕ^(9/2)),3 (ϕ^2),ϕ,2ϕ},*)
}(Sqrt[(ϕ/2)]);
edges={};
(* Create all permutations of vertices *)
verticesHyperboloid=Flatten[Map[(EvenPermutationsHyperboloid[#])&,verticesHyperboloid],1];
vertices=Map[HyperboloidToKlein,verticesHyperboloid];
(* Add plus or minus signs *)
vertices=Flatten[Map[PlusMinus,vertices],1];
Print["Number of vertices is:"]
Print[Length[vertices]]
(* Numerical *)
vertices = vertices 1.0;
verticesHyperboloid=Map[KleinToHyperboloid,vertices];
Print["Generating edges. Please wait..."]
For[i=1,i≤Length[vertices],i++,
For[j=i+1,j≤Length[vertices],j++,
distance=DistanceHyperboloid[verticesHyperboloid[[i]],verticesHyperboloid[[j]]];
If[distance>1.1coshEdge,
(* no edge *),
If[distance<0.9 coshEdge,
(* Error! *)
Print["Error"],
AppendTo[edges,{i,j,3(1-Norm[((vertices[[i]]+vertices[[j]])/2)])}]]]]]
Print["Number of edges is:"]
Print[Length[edges]]
Graphics3D[{Table[Line[{vertices[[edges[[i,1]]]],vertices[[edges[[i,2]]]]},VertexColors->{Hue[edges[[i,3]]],Hue[edges[[i,3]]]}],{i,1,Length[edges]}]},Boxed->False,ViewPoint->{2,2,3},ViewVertical->{1,0,0},ImageSize->600]

ϕ=GoldenRatio;
coshEdge=ϕ;
(* Starting from Klein model *)
vertices={{1,1,1},{ϕ,0,1/ϕ},{2ϕ/(Sqrt[5]),(ϕ^2)/(Sqrt[5]),ϕ/(Sqrt[5])},{ϕ,0,(ϕ^2)/(Sqrt[5])},{(ϕ^3)/(Sqrt[5]),1/(Sqrt[5]),1/(Sqrt[5])},{(ϕ^3)/3,(ϕ^3)/3,1/3},{2(ϕ^2)/3,(ϕ^2)/3,ϕ/3},{(Sqrt[5])(ϕ^2)/3,ϕ/3,0},{ϕ+1/(ϕ^4),1,1/(ϕ^3)},{3/ϕ,(Sqrt[5])/(ϕ^2),0},{ϕ,2/ϕ,1/(ϕ^4)}
} (ϕ^(-3/2));
edges={};
(* Create all permutations of vertices *)
vertices=Flatten[Map[(EvenPermutationsKlein[#])&,vertices],1];
(* Add plus or minus signs *)
vertices=Flatten[Map[PlusMinus,vertices],1];
Print["Number of vertices is:"]
Print[Length[vertices]]
(* Numerical *)
vertices = vertices 1.0;
verticesHyperboloid=Map[KleinToHyperboloid,vertices];
Print["Generating edges. Please wait..."]
For[i=1,i≤Length[vertices],i++,
For[j=i+1,j≤Length[vertices],j++,
distance=DistanceHyperboloid[verticesHyperboloid[[i]],verticesHyperboloid[[j]]];
If[distance>1.01coshEdge,
(* no edge *),
If[distance<0.99 coshEdge,
(* Error! *)
Print["Error"],
AppendTo[edges,{i,j,3(1-Norm[((vertices[[i]]+vertices[[j]])/2)])}]]]]]
Print["Number of edges is:"]
Print[Length[edges]]
Graphics3D[{Table[Line[{vertices[[edges[[i,1]]]],vertices[[edges[[i,2]]]]},VertexColors->{Hue[edges[[i,3]]],Hue[edges[[i,3]]]}],{i,1,Length[edges]}]},Boxed->False,ViewPoint->{5,1,2},ViewVertical->{1,0,0},ImageSize->600]