WOLFRAM|DEMONSTRATIONS PROJECT

Mazes on Polyhedra Seen from Two Viewpoints

telo1={PolyhedronData["Tetrahedron","FaceIndices"],PolyhedronData["Tetrahedron","VertexCoordinates"]//N};​​telo2={PolyhedronData["Cube","FaceIndices"],PolyhedronData["Cube","VertexCoordinates"]//N};​​telo3={PolyhedronData["Octahedron","FaceIndices"],PolyhedronData["Octahedron","VertexCoordinates"]//N};​​telo4={{{1,2,3,4},{1,5,6,2},{2,9,10,3},{3,10,11,4},{4,8,5,1},{4,11,12,8},{5,13,14,6},{6,14,9,2},{8,12,13,5},{9,14,7,10},{10,7,12,11},{13,12,7,14}},{{0.5257311121191335`,-0.5257311121191335`,0},{0.5257311121191335`,0,-0.8506508083520399`},{0.5257311121191335`,0.5257311121191335`,0},{0.5257311121191335`,0,0.8506508083520399`},{0.`,-1.376381920471173`,0},{0.`,-0.8506508083520399`,-0.8506508083520399`},{-0.5257311121191335`,0.5257311121191335`,0},{0.`,-0.8506508083520399`,0.8506508083520399`},{0.`,0.8506508083520399`,-0.8506508083520399`},{0.`,1.376381920471173`,0},{0.`,0.8506508083520399`,0.8506508083520399`},{-0.5257311121191335`,0.`,0.8506508083520399`},{-0.5257311121191335`,-0.5257311121191335`,0},{-0.5257311121191335`,0.`,-0.8506508083520399`}}};​​telo5={{{1,2,3,4},{1,5,6,2},{2,9,10,3},{2,15,16,9},{3,10,11,4},{4,8,5,1},{4,11,12,8},{5,21,22,6},{6,22,15,2},{8,20,21,5},{9,16,17,10},{10,17,18,11},{11,18,19,12},{12,19,20,8},{13,19,7,14},{16,14,7,17},{17,7,19,18},{20,19,13,21},{21,13,14,22},{22,14,16,15}},{{0.5257311121191335`,-0.5257311121191335`,0},{0.5257311121191335`,0,-0.8506508083520399`},{0.5257311121191335`,0.5257311121191335`,0},{0.5257311121191335`,0,0.8506508083520399`},{0.`,-1.376381920471173`,0},{0.`,-0.8506508083520399`,-0.8506508083520399`},{-1.376381920471173`,0.5257311121191335`,-0.5257311121191331`},{0.`,-0.8506508083520399`,0.8506508083520399`},{0.`,0.8506508083520399`,-0.8506508083520399`},{0.`,1.376381920471173`,0},{0.`,0.8506508083520399`,0.8506508083520399`},{-0.5257311121191335`,0.`,0.8506508083520399`},{-1.376381920471173`,-0.5257311121191335`,-0.5257311121191331`},{-1.376381920471173`,0.`,-1.376381920471173`},{-0.3249196962329066`,0,-1.376381920471173`},{-0.8506508083520401`,0.8506508083520399`,-1.376381920471173`},{-0.8506508083520401`,1.376381920471173`,-0.5257311121191331`},{-0.8506508083520401`,0.8506508083520399`,0.3249196962329068`},{-1.376381920471173`,0.`,0.3249196962329068`},{-0.8506508083520401`,-0.8506508083520399`,0.3249196962329068`},{-0.8506508083520401`,-1.376381920471173`,-0.5257311121191331`},{-0.8506508083520401`,-0.8506508083520399`,-1.376381920471173`}}};​​telo6={{{1,2,3,4},{1,9,10,2},{2,10,11,3},{3,7,8,4},{3,11,12,7},{4,8,5,1},{5,14,9,1},{7,12,13,8},{8,13,14,5},{9,14,6,10},{10,6,12,11},{14,13,12,6}},{{0,-0.816496580927726`,-0.816496580927726`},{-0.5773502691896258`,0,-0.816496580927726`},{0,0.816496580927726`,-0.816496580927726`},{0.5773502691896258`,0,-0.816496580927726`},{0.5773502691896256`,-0.816496580927726`,1.110223024625156`*^-16},{-0.577350269189626`,0,0.8164965809277261`},{0.5773502691896256`,0.816496580927726`,1.110223024625156`*^-16},{1.154700538379251`,0,1.110223024625156`*^-16},{-0.5773502691896258`,-0.816496580927726`,1.110223024625156`*^-16},{-1.154700538379251`,0,1.110223024625156`*^-16},{-0.5773502691896258`,0.816496580927726`,1.110223024625156`*^-16},{-2.220446049250313`*^-16,0.816496580927726`,0.8164965809277261`},{0.5773502691896256`,0,0.8164965809277261`},{-2.220446049250313`*^-16,-0.816496580927726`,0.8164965809277261`}}};​​telo7={PolyhedronData["Bilunabirotunda","FaceIndices"],PolyhedronData["Bilunabirotunda","VertexCoordinates"]//N};​​​​
telesa1={telo1,telo2,telo3,telo4,telo5,telo6,telo7};​​viewp=10{{4,0.2,-2},{3,2.2,-2},{5,0.2,-2},{4,0.2,-2},{4,0.2,-2},{4,1.5,-2},{2,.2,10}};
Manipulate[​​SeedRandom[ranint];With[{p1=telesa1[[solid]]},​​With[{lab1=Labirint[p1,mm,viewp[[solid]],GrayLevel[1],RGBColor[0.756863,0,0],If[show2,RGBColor[0,0.917647,0.917647],GrayLevel[0]]]},With[{prava=lab1[[5]],choices=Join[{0},lab1[[6]]]},Column[{Text@Row[{"find"," the length"," of the shortest"," path from black to blue point",Spacer[15],PopupMenu[Dynamic[an],choices]," ",If[anprava,True,False]}],​​If[!show,​​Row[{ExpressionCell[lab1[[1]],DeployedTrue],ExpressionCell[lab1[[2]],DeployedTrue]}],Row[{ExpressionCell[lab1[[3]],DeployedTrue],ExpressionCell[lab1[[4]],DeployedTrue]}]]},AlignmentCenter]]]],​​Grid[{{​​Control[{{solid,4,"solid"},1,7,1,SetterBar}],​​Spacer[40],​​Control[{{mm,0,"divide faces"},0,1,1,SetterBar}]},​​{Control[{{show2,True,"show common edge"},{False,True}}],​​Spacer[40],​​Control[{{show,False,"show solution"},{False,True}}]}}],​​{{ranint,10},ControlTypeNone},​​{an,0,ControlTypeNone},​​Button["new maze",an=0;show=False;ranint=RandomInteger[{1,200}]],​​SaveDefinitionsTrue,​​SynchronousInitializationFalse,​​AutorunSequencing{2,3}]
​
solid
1
2
3
4
5
6
7
divide faces
0
1
show common edge
show solution
new maze
SelectFirst
::shdw
:Symbol SelectFirst appears in multiple contexts {Notebook$$17$506639`,System`}​; definitions in context Notebook$$17$506639` may shadow or be shadowed by other definitions.
​
Many polyhedra have property that all their faces are visible from two opposite directions. A maze and these two views of a polyhedron are shown. Find the shortest path connecting the two dots.