Investigamos en distintos espacios para así brindarte la solución a tu dilema, si continúas con alguna difcultad puedes dejar tu comentario y respondemos porque estamos para servirte.
Solución:
Editar: olvidé agregar un enlace necesario
Casualmente, hace un tiempo tuve un pequeño proyecto personal tratando de hacer un buen tirador de dados en Mathematica. Aquí hay algo de mi código (nota: esto fue antes de que aprendiera muchas técnicas de eficiencia, por lo que no es rápido, pero hace una animación bastante decente). Sin embargo, no me disculpo por la horrible combinación de colores …
Construyendo el objeto dado
Hace una textura para los lados.
plt[num_] :=
ReliefPlot[
Table[i + Sin[i^2 + j^2], i, -4, 4, .03, j, -4, 4, .03],
ColorFunction -> "SunsetColors",
Epilog ->
Inset[Text[Style[ToString[num], Bold, 40, Underlined]], Center,
Center, Center, Center]];
Crea una sola cara de dado
makeFace[num_] := Texture[[email protected][num]],
Append[#1, VertexTextureCoordinates ->
With[n = Length[First[#1]],
Table[1/2 Cos[2 [Pi] i/n], Sin[2 [Pi] i/n] + 1/2,
1/2, i, 0, n - 1]]] &@
Polygon[dat[[1, dat[[2, 1, num]]]]]
Hace un faces dados de caras construyendo cada individuo GraphicsComplex
dice[faces_] := Quiet[Module[shape,
shape =
Switch[faces, 4, "Tetrahedron", 6, "Cube", 8, "Octahedron",
10, "Dipyramid", 5, 12, "Dodecahedron", 20, "Icosahedron", _,
Missing["InvalidDice"]];
dat = PolyhedronData[shape, "Faces"];
If[Head[dat] === GraphicsComplex,
Graphics3D[makeFace /@ Range[faces], Lighting -> "Neutral",
Boxed -> False], shape]]]
Probar un dado de 8 caras:
dice[8]
Rodando el gráfico
Límites de los dados (esto podría mejorarse con BoundingRegion)
minz = Min[dat[[1, All, 3]]];
minx = Min[dat[[1, All, 1]]];
miny = Min[dat[[1, All, 2]]];
maxx = Max[dat[[1, All, 1]]];
maxy = Max[dat[[1, All, 2]]];
Redefinir los dados para poder cambiar el punto de vista
dice[faces_, opts___] := Quiet[Module[shape,
shape =
Switch[faces, 4, "Tetrahedron", 6, "Cube", 8, "Octahedron",
10, "Dipyramid", 5, 12, "Dodecahedron", 20, "Icosahedron", _,
Missing["InvalidDice"]];
dat = PolyhedronData[shape, "Faces"];
If[Head[dat] === GraphicsComplex,
Graphics3D[makeFace /@ Range[faces], Boxed -> False,
SphericalRegion -> True, opts], shape]]]
En este punto, simplemente copié un montón de buenos puntos de vista para cada gráfico, pero probablemente podrías automatizar esto. Adjuntaré la definición de las ubicaciones de las vistas, pero tiene el formato view = <| numberoffaces -> <|sidenumber -> viewpoint, sidenumber2 -> viewpoint2|>...|> por cada lado de los dados.
Aquí están los datos (enlace pastebin)
Ahora elige un rollo al azar:
random[faces_] :=
dice[faces, ViewPoint -> view[faces, RandomInteger[1, faces]]]
Agregue un rebote (oh wow, olvidé lo lejos que fui con esto …)
bn[n_] := Abs[Sin[n/(2 Pi)]]*n/30;
roll[faces_, opts___] := Module[graphic,
graphic = random[faces];
Animate[
Graphics3D[Rotate[graphic[[1]], n Degree, 1, 1, 1],
Polygon[minx - 2, miny - 2, minz + bn[n], maxx + 2,
miny - 2, minz + bn[n], maxx + 2, maxy + 2,
minz + bn[n], minx - 2, maxy + 2, minz + bn[n]],
Sequence @@ graphic[[2 ;;]], opts], n, -120, 0,
AnimationRepetitions -> 1, AnimationRate -> 60,
AppearanceElements -> None]]
El rebote es así:
Poniendo todo junto
Un solo rollo:
roll[faces_] := Module[graphic, i,
makeFace[
num_] := Texture[
[email protected][
Text[Style[ToString[num], Bold, 30, Underlined]]]],
Append[#1, VertexTextureCoordinates ->
With[n = Length[First[#1]],
Table[1/2 Cos[2 [Pi] i/n], Sin[2 [Pi] i/n] + 1/2,
1/2, i, 0, n - 1]]] &@
Polygon[dat[[1, dat[[2, 1, num]]]]];
dice[n_, opts___] := Quiet[Module[shape,
shape =
Switch[n, 4, "Tetrahedron", 6, "Cube", 8, "Octahedron",
10, "Dipyramid", 5, 12, "Dodecahedron", 20, "Icosahedron", _,
Missing["InvalidDice"]];
dat = PolyhedronData[shape, "Faces"];
If[Head[dat] === GraphicsComplex,
Graphics3D[makeFace /@ Range[n], Lighting -> "Neutral",
Boxed -> False, SphericalRegion -> True, opts], shape]]];
random[n_] :=
dice[n, ViewPoint -> view[n, i = RandomInteger[1, n]]];
graphic = random[faces];
Animate[
Graphics3D[Rotate[graphic[[1]], n Degree, 1, 1, 1],
Sequence @@ graphic[[2 ;;]]], n, -120, 0,
AnimationRepetitions -> 1, AnimationRate -> 60,
AppearanceElements -> None], i]
Probar eso:
roll[8]
La aplicación completa (debe evaluar el view definición en el enlace):
CreateDialog[Pane[DynamicModule[, Row[Grid[
"Select dice: ",
Row["d", PopupMenu[Dynamic[num], 4, 6, 8, 10, 12, 20]],
Button["Roll!", out = roll[num];
AppendTo[history, Text["d" <> ToString[num]], out[[2]]]],
SpanFromLeft,
Dynamic[out[[1]]], SpanFromLeft],
Column[Button["Reset history?",
history = Style["History", "Text", Bold, 14],
SpanFromLeft;],
Pane[Dynamic[Grid[history]], 200, 400, Scrollbars -> True],
Dynamic[If[Length[history] > 1,
Text["Mean: " <> ToString[[email protected][history[[2 ;;, 2]]]]],
""]]]],
Alignment -> Left,
BaseStyle -> "Text", 14,
Initialization :> (history = Style["History", "Text", Bold, 14],
SpanFromLeft;
roll[faces_] := Module[graphic, i,
makeFace[
num_] := Texture[
[email protected][
Text[Style[ToString[num], Bold, 30, Underlined]]]],
Append[#1, VertexTextureCoordinates ->
With[n = Length[First[#1]],
Table[1/2 Cos[2 [Pi] i/n], Sin[2 [Pi] i/n] + 1/2,
1/2, i, 0, n - 1]]] &@
Polygon[dat[[1, dat[[2, 1, num]]]]];
dice[n_, opts___] := Quiet[Module[shape,
shape = Switch[n, 4, "Tetrahedron", 6, "Cube", 8,
"Octahedron", 10, "Dipyramid", 5, 12, "Dodecahedron",
20, "Icosahedron", _, Missing["InvalidDice"]];
dat = PolyhedronData[shape, "Faces"];
If[Head[dat] === GraphicsComplex,
Graphics3D[makeFace /@ Range[n], Lighting -> "Neutral",
Boxed -> False, SphericalRegion -> True, opts], shape]]];
random[n_] :=
dice[n, ViewPoint -> view[n, i = RandomInteger[1, n]]];
graphic = random[faces];
Animate[
Graphics3D[Rotate[graphic[[1]], n Degree, 1, 1, 1],
Sequence @@ graphic[[2 ;;]]], n, -120, 0,
AnimationRepetitions -> 1, AnimationRate -> 60,
AppearanceElements -> None], i
];
out = roll[8]
)]]]
¡Uf! No pensé que estaría publicando eso, pero ahí lo tienes, tal vez hay algunas partes que podrías usar.
El trapezoedro pentagonal es el dual del antiprisma pentagonal:
PolyhedronData["Antiprism", 5]
Desafortunadamente, el dual no está en PolyhedronData:
PolyhedronData["Antiprism", 5, "Dual"]
(* Missing["NotApplicable"] *)
Entonces, aquí hay una función para calcular el dual de un poliedro. (Es una adaptación de dual para que las mallas en mi respuesta creen una malla (casi) hexagonal en un elipsoide a poliedros que tienen duales).
ClearAll[dual, sortvertices, reciprocate];
sortvertices[coords_, normal_, face_] :=
With[proj = DeleteCases[
Orthogonalize[Join[normal, [email protected][3]]], 0., 0., 0.][[2 ;; 3]],
SortBy[face, ArcTan @@ (proj.coords[[#]]) &]];
reciprocate[face_?MatrixQ, r_: 1] /; Length[face] >= 3 :=
r^2 1, -1, 1 Most[#]/Last[#] &@ [email protected][email protected][email protected] Join[
0, 0, 0, 0,(* dummy row *)
PadRight[face[[;; 3]], Automatic, 4, 1]
];
dual[polyhedron : [email protected][coords_, Polygon[faces_]]] :=
With[nvertices = [email protected], nfaces = Len[email protected],
With[mat = [email protected][email protected] Table[v, f -> 1, f, nfaces, v, faces[[f]]],
dualcoords = reciprocate[coords[[#]]] & /@ faces,
With[dualfaces = mat["AdjacencyLists"],
[email protected] GraphicsComplex[
dualcoords,
Polygon[Table[sortvertices[dualcoords, coords[[v]], dualfaces[[v]]],
v, [email protected]]]]]]];
El trapezoedro pentagonal:
[email protected] PolyhedronData["Antiprism", 5]
Aquí tienes un comienzo para definir tus polígonos. Esta página tiene coordenadas para muchas formas diferentes. No estoy familiarizado con el formato, es posible que pueda importar este archivo de coordenadas directamente. Pero un poco de copiar / pegar, cambiar los índices para comenzar en 1, y tiene esto
verts [C0_,C1_,C2_]:=
0,C0,C1,0,C0,-C1,
0,-C0,C1,0,-C0,-C1,
1/2,1/2,1/2,1/2,1/2,-(1/2),
-(1/2),-(1/2),1/2,-(1/2),-(1/2),-(1/2),
C2,-C1,0,-C2,C1,0,
C0,C1,0,-C0,-C1,0;
faces=9,3,7,12,9,12,8,4,
9,4,2,6,9,6,11,5,
9,5,1,3,10,1,5,11,
10,11,6,2,10,2,4,8,
10,8,12,7,10,7,3,1;
[email protected][
verts[(Sqrt[5]-1)/4,(Sqrt[5]+1)/4,(Sqrt[5]+3)/4],
Polygon/@faces]
Ahora todo lo que necesitas hacer es aplicar texturas.
Comentarios y calificaciones del tutorial
Tienes la posibilidad compartir esta noticia si te valió la pena.