Tietze's Graph

Author

Eric W. Weisstein
August 21, 2022

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/TietzesGraph.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/TietzesGraph.html.

©2022 Wolfram Research, Inc. except for portions noted otherwise

Graph

Primary

GraphData["TietzeGraph"]//StyleGraphs

Construction from Read and Wilson

All

GraphData["TietzeGraph","Graph","All"]//StyleGraphs

LCF

GraphData["TietzeGraph","LCFSignature"]

GraphData["TietzeGraph","Graph","LCF"]//StyleGraphs

Planar

GraphData["TietzeGraph","Planar"]

GraphData["TietzeGraph","Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData["TietzeGraph","CrossingNumber"]

GraphData["TietzeGraph","Graph","MinimalCrossing"]//StyleGraphs

UnitDistance

GraphData["TietzeGraph","Graph","UnitDistance"]//StyleGraphs

UnitDistance FindSubgraphUnitDistanceEmbedding

{"TietzeGraph",l=FindSubgraphUnitDistanceEmbedding[GraphData["TietzeGraph"],TimeConstraint->300,"Results"->All]//Timing}

gs=UniqueEmbeddings[l]

gs={,,,,,,,};

3D Polyhedron

GraphData["MoserSpindle","Polyhedral"]

GraphData["MoserSpindle","Graph",{"3D","Polyhedron"}]

GrapData

Matrices

GraphicsRow[GraphMatrixPlot[GraphData["TietzeGraph"]]]

GraphClassString

GraphClassString["TietzeGraph"]

Embeddings

Nonagon inside triangle

v=Join[CirclePoints[Csc[Pi/9]/2,9],CirclePoints[4,3]];
g=Graph[Range[12],Sort[Sort/@Join[UnitEdges[v],UndirectedEdge@@@Join[Partition[Range[10,12],2,1,1],{{8,12},{2,10},{5,11},{1,6},{3,7},{4,9}}]]],VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Triangle inside nonagon

Pre-V13.0:

v=Join[CirclePoints[Csc[Pi/9]/2,9],CirclePoints[Csc[Pi/3]/2,3]];
g=Graph[Range[12],Sort[Sort/@Join[UnitEdges[v],UndirectedEdge@@@{{5,11},{8,12},{2,10},{3,7},{4,9},{1,6}}]],VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Generalized wrong flower snark

From Read and Wilson, p. 276 "Flower snark (Subscript[J, 5])"

WrongFlowerSnark1[n_]:=Module[{e=
Join[
Partition[Range[n],2,1,1],
{#,#+n}&/@Range[n],
Partition[Range[2n+1,4n],2,1,1],
{#,2#}&/@Range[n+1,2n],
{#,2#-3}&/@Range[n+2,2n],
{{n+1,4n-1}}
],
v=Join[
CirclePoints[{3/4,Pi/n-Pi/2},n],
CirclePoints[{5/4,Pi/n-Pi/2},n],
CirclePoints[{2,π (1/2)/n+Pi/n-Pi/2},2n]]
},
Graph[Range[Length[v]],UndirectedEdge@@@Sort[Sort/@e],VertexCoordinates->v]
]

WrongFlowerSnark1[3]

RecognizeGraph[%]

UnitDistance (Eric Weisstein)

GraphData["TietzeGraph",{"TriangleCount","SquareCount"}]

GraphData["TietzeGraph","Graphics","All"][[2]]

GraphData["TietzeGraph","Graphics","All"][[3]]

Rotate[,π/2]

s=Sqrt[3]/2;

h=.

soln=NSolve[{
u^2+v^2==1,
(u-1/2)^2+(v-y)^2==1,
(x-1/2)^2+(y-z)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-1/2)^2+(z-1+s)^2==1,
(1/2+u)^2+(h-v)^2==1},{x,y,z,u,v,h},Reals]

gs=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,4},{2,3},{3,8},{2,5},{5,6},{6,7},{7,8},{4,9},{4,10},{6,9},{7,10},{8,12},{5,11},{10,11},{9,12},{11,12}},VertexCoordinates->({{0,1},{-1/2,1-s},{1/2,1-s},{0,0},{-x,z},{-1/2,y},{1/2,y},{x,z},{-u,v},{u,v},{-1/2,h},{1/2,h}}/.#),VertexLabels->"Name"]&/@soln

DegenerateEmbeddingQ/@gs

RecognizeGraph/@gs

soln=Solve[{
u^2+v^2==1,
(u-1/2)^2+(v-y)^2==1,
(x-1/2)^2+(y-z)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-1/2)^2+(z-1+s)^2==1,
(1/2+u)^2+(h-v)^2==1},{x,y,z,u,v,h},Reals]

v=Join[CirclePoints[Csc[Pi/6]/2,6],CirclePoints[(Sqrt[(1/10)(5-(Sqrt[5]))]),5],{Mean[v[[{3,4}]]]+{0,1}}];

EuclideanDistance@@v[[{4,5}]]//N

EuclideanDistance@@v[[{7,10}]]//N

EuclideanDistance@@v[[{5,10}]]//N

EuclideanDistance@@v[[{6,11}]]//N

g=Graph[Range[12],UndirectedEdge@@@{{4,12},{3,4},{3,12},{2,3},{1,2},{1,6},{5,6},{4,5},{9,12},{7,9},{7,10},{8,10},{8,11},{9,11},{6,11},{1,7},{2,8},{5,10}},VertexCoordinates->v,VertexLabels->"Name"]

r=RecognizeGraph@g

None of this shape:

s=Sqrt[3]/2;

soln=NSolve[{
u^2+v^2==1,
(u+1/2)^2+(v-y)^2==1,
(x-1/2)^2+(z-y)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-1/2)^2+(1-s-z)^2==1,
(u-1/2)^2+(v-h)^2==1},{x,y,z,u,v,h},Reals]

gs=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,4},{2,3},{3,8},{8,12},{11,12},{5,11},{2,5},{4,9},{4,10},{5,6},{6,7},{7,8},{7,9},{6,10},{9,11},{10,12}},VertexCoordinates->({{0,1},{-1/2,1-s},{1/2,1-s},{0,0},{-x,z},{-1/2,y},{1/2,y},{x,z},{-u,v},{u,v},{-1/2,h},{1/2,h}}/.#),VertexLabels->"Name"]&/@soln

RecognizeGraph/@gs

DegenerateEmbeddingQ/@gs

v3={0,1}+RotationMatrix[60Degree].{a,b-1}//Simplify

soln=NSolve[{
u^2+v^2==1,
(u+1/2)^2+(v-y)^2==1,
(x-1/2)^2+(z-y)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-v3[[1]])^2+(z-v3[[2]])^2==1,
(u-1/2)^2+(v-h)^2==1,
a^2+(b-1)^2==1,
(a+x)^2+(b-z)^2==1},{x,y,z,u,v,h,a,b},Reals]

gs=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,4},{2,3},{3,8},{8,12},{11,12},{5,11},{2,5},{4,9},{4,10},{5,6},{6,7},{7,8},{7,9},{6,10},{9,11},{10,12}},VertexCoordinates->({{0,1},{a,b},v3,{0,0},{-x,z},{-1/2,y},{1/2,y},{x,z},{-u,v},{u,v},{-1/2,h},{1/2,h}}/.#),VertexLabels->"Name"]&/@soln

RecognizeGraph/@gs

DegenerateEmbeddingQ/@gs

UnitDistanceEmbeddingQ/@gs

Pick[gs,!DegenerateEmbeddingQ[#]&/@gs]

EdgeLengths/@%134

soln=NSolve[{
u^2+v^2==1,
(u+1/2)^2+(v-y)^2==1,
(x-1/2)^2+(z-y)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-v3[[1]])^2+(z-v3[[2]])^2==1,
(u-1/2)^2+(v-h)^2==1,
a^2+(b-1)^2==1,
(a+x)^2+(b-z)^2==1},{x,y,z,u,v,h,a,b},Reals,WorkingPrecision->50]

soln=NSolve[{
u^2+v^2==1,
(u+1/2)^2+(v-y)^2==1,
(x-1/2)^2+(z-y)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-v3[[1]])^2+(z-v3[[2]])^2==1,
(u-1/2)^2+(v-h)^2==1,
a^2+(b-1)^2==1,
(a+x)^2+(b-z)^2==1,
a==895/1000},{x,y,z,u,v,h,a,b},Reals,WorkingPrecision->20]

gs=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,4},{2,3},{3,8},{8,12},{11,12},{5,11},{2,5},{4,9},{4,10},{5,6},{6,7},{7,8},{7,9},{6,10},{9,11},{10,12}},VertexCoordinates->({{0,1},{a,b},v3,{0,0},{-x,z},{-1/2,y},{1/2,y},{x,z},{-u,v},{u,v},{-1/2,h},{1/2,h}}/.#),VertexLabels->"Name"]&/@soln

soln=FindRoot[Evaluate[{
u^2+v^2==1,
(u+1/2)^2+(v-y)^2==1,
(x-1/2)^2+(z-y)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-v3[[1]])^2+(z-v3[[2]])^2==1,
(u-1/2)^2+(v-h)^2==1,
a^2+(b-1)^2==1,
(a+x)^2+(b-z)^2==1}/.v3->{(1/2) (a-(Sqrt[3]) (-1+b)),(1/2) (1+(Sqrt[3]) a+b)}],{{x,-0.06301625030524724`},{y,0.2827015220906312`},{z,1.109147347231166`},{u,0.2214454914344793`},{v,0.9751727510156045`},{h,1.935593172371701`},{a,0.8958123043326542`},{b,0.555567423104273`}},WorkingPrecision->200,PrecisionGoal->100]

{x->-0.06301625030524711899964042864300210118792807086715616756425657394913629307676699683320246793163998097773934581221234884416818071330048129186351729474619147554162041296341002597585733192648873554251223595472638565`200.,y->0.28270152209063104267052900927972901611127312052895600544229908479399606182512232856096825535265146586078190411056934258860990536430656349129489033915065769379004029237192670008082773218499590545522510495381231827`200.,z->1.10914734723116578271964933257242292499996473109018333112815704290868035692945095050484800340017523340052129771909609031642070222227108421369178620231217638642925407386027215116937507029763936142727199029420676609`200.,u->0.22144549143447913093162199657139721400057115413410038586131856021644344803401560640815398775409897939897089664348925832915779530644716902696125476621464203440124906120499731882661074218839866840566030049457000574`200.,v->0.97517275101560442948337250332535910847136735799537364515606053263464686538385096904542109677879952123833436842679944183140567476977056045309761395835936321069330068981142494220336248034818169888890449795037839951`200.,h->1.9355931723717005227687696558651168338886563416514106568140150010233646520337795724487277514476990009402606913276228380442314990802356049360886820654736950790684678553486176022579224084102828173993188756346012139`200.,a->0.89581230433267347613554004348252202525283467310994654752852085210315762248375663384440255794140895211282366571188874570524624860936010256757694622587371776926779905594776765759144510644669976900462760539487762629`200.,b->0.55556742310426253181129497009900953409044793987306561555733231198466269827533967975189857474060381466703122056208172612407712843410718517443460764491425678182323624049505069068670554833258524768970692186578297699`200.}

gs=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,4},{2,3},{3,8},{8,12},{11,12},{5,11},{2,5},{4,9},{4,10},{5,6},{6,7},{7,8},{7,9},{6,10},{9,11},{10,12}},VertexCoordinates->(vs={{0,1},{a,b},v3,{0,0},{-x,z},{-1/2,y},{1/2,y},{x,z},{-u,v},{u,v},{-1/2,h},{1/2,h}}/.#),VertexLabels->"Name"]&@soln

EdgeLengths[gs]-1

RootApproximant[a/.soln]

vs

ra=RootApproximant[vs]

ra-vs

soln=Solve[{u^2+v^2==1,
(u+1/2)^2+(v-y)^2==1,
(x-1/2)^2+(z-y)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-v3[[1]])^2+(z-v3[[2]])^2==1,
(u-1/2)^2+(v-h)^2==1,
a^2+(b-1)^2==1,
(a+x)^2+(b-z)^2==1,
a==(NumericalApproximation[Root, (RowDefault["0.896", FEExpressionsNumericalApproximationElider]), Root[13+68 #1+100 ((#1)^2)-40 ((#1)^3)-236 ((#1)^4)-160 ((#1)^5)+64 ((#1)^6)+128 ((#1)^7)+64 ((#1)^8)&,3], ])},{x,y,z,h,u,v,a,b},Reals]

gs=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,4},{2,3},{3,8},{8,12},{11,12},{5,11},{2,5},{4,9},{4,10},{5,6},{6,7},{7,8},{7,9},{6,10},{9,11},{10,12}},VertexCoordinates->({{0,1},{a,b},v3,{0,0},{-x,z},{-1/2,y},{1/2,y},{x,z},{-u,v},{u,v},{-1/2,h},{1/2,h}}/.#),VertexLabels->"Name"]&/@soln

g=gs[[-1]]

r=RecognizeGraph[g]

UnitDistanceEmbeddingQ[g,WorkingPrecision->∞]//FullSimplify

DegenerateEmbeddingQ[g]

Do[
soln=NSolve[{u^2+v^2==1,
(u+1/2)^2+(v-y)^2==1,
(x-1/2)^2+(z-y)^2==1,
(1/2-x)^2+(h-z)^2==1,
(x-v3[[1]])^2+(z-v3[[2]])^2==1,
(u-1/2)^2+(v-h)^2==1,
a^2+(b-1)^2==1,
(a+x)^2+(b-z)^2==1},{x,y,z,h,u,v,b},Reals];
Print[{a,gs=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,4},{2,3},{3,8},{8,12},{11,12},{5,11},{2,5},{4,9},{4,10},{5,6},{6,7},{7,8},{7,9},{6,10},{9,11},{10,12}},VertexCoordinates->({{0,1},{a,b},v3,{0,0},{-x,z},{-1/2,y},{1/2,y},{x,z},{-u,v},{u,v},{-1/2,h},{1/2,h}}/.#),VertexLabels->"Name"]&/@soln}],
{a,.89,.9,.01}]

UnitDistance (Jeremy Tan)

Jeremy Tan, Oct. 20, 2021
Communicated by Ed Pegg, Jr.

vertices=ReIm/@Module[{t,b,c,c2,d,e},
t=Root[52#^4-15#^2-30#-3,2];
b=1/Sqrt[3];
c=b+Exp[2I Pi/3];
c2=c Exp[2I Pi/3];
d=c-t-Sqrt[1-t^2]I;
e=cu[d,c2];
RootReduce[Flatten[Table[{b,c,d,e} Exp[2I k Pi/3],{k,0,2}]]]]//RootReduce

edges=UnitEdges[vertices]

g1=RotateGraph[Graph[Range[Length[vertices]],edges,VertexCoordinates->vertices,VertexLabels->Automatic],{11,3}]

VertexCount[g1]

Intersection[GraphData["UnitDistance*"],GraphData[12]]

UnitDistanceGraphEmbeddingQ[g1]

RecognizeGraph[g1]

tietzeedges={1\[UndirectedEdge]2,2\[UndirectedEdge]3,3\[UndirectedEdge]4,1\[UndirectedEdge]5,4\[UndirectedEdge]6,3\[UndirectedEdge]8,5\[UndirectedEdge]6,6\[UndirectedEdge]7,7\[UndirectedEdge]8,5\[UndirectedEdge]9,8\[UndirectedEdge]10,7\[UndirectedEdge]12,9\[UndirectedEdge]10,10\[UndirectedEdge]11,11\[UndirectedEdge]12,9\[UndirectedEdge]1,12\[UndirectedEdge]2,11\[UndirectedEdge]4}

g=Graph[Range[Length[vertices]],tietzeedges,VertexCoordinates->vertices]

RecognizeGraph[g]

UnitDistanceGraphEmbeddingQ[g]

file=OpenWrite["~/ud12-3.m"]

WriteString[file,GraphDataString[g1,
"StandardName"->{"UnitDistance",{12,3}},
"Name"->"12\[Hyphen]unit distance graph 3",
"Information"->"Unit-DistanceGraph",
Debug->True,
TimeConstraint->60
]]

Close[file]