Re: animated faces of polygon
- To: mathgroup at smc.vnet.net
- Subject: [mg91654] Re: animated faces of polygon
- From: Caroling Geary <caroling at mchsi.com>
- Date: Sun, 31 Aug 2008 04:31:32 -0400 (EDT)
- References: <200808300551.BAA02685@smc.vnet.net>
I found an example of exactly the kind of animation I'd like to apply to a triangle as part of a tetrahedron. It is "Time Evolution of a Four-Spring Tree-Mass System" from The Wolfram Demonstrations Project http://demonstrations.wolfram.com/ TimeEvolutionOfAFourSpringThreeMassSystem/ by Michael Trott. Would this be obscurely hard or doable? I'll attach the code to this email for your convenience. I've gotten the following help from David Mitchell in Technical Support (he suggests "translation matrices". I looked in help and am sorry but I'm not getting it right off. Any clues would be welcome)" "Effects similar to what you describe are available in Matheamtica. While there are probably many different such ways to do this, I would use translation matrices to rotate 4 separate surfaces to appear as a tetrahedron. At this point, one could set certain parameters of the surface to be manipulated and rotate the shape." Time Evolution of a Four-Spring Three-Mass System spring[{x0_, x1_}, y_, h_] := Line[Join[{{First[#], y}}, MapIndexed[If[EvenQ[#2[[1]]], {#1, y + h}, {#1, y - h}] &, Drop[Drop[#, 1], -1]], {{Last[#], y}}]] &[ If[x0 == x1, Table[x0, {13}], Table[x, {x, x0, x1, (x1 - x0)/ 12}]]]; makePicture[=CE=B4initialPositions_, initialVelocities_, m_, T_] := Module[{n = 3, =CE=BB, ef, sol, =CF=88s, tab, L, a, b, t}, n = 3; =CE=BB = (n + 1) 0.33 1/(m + 1); ef = Table[Sqrt[2] Sqrt[1. - Cos[i Pi/(n + 1)]], {i, n}]; sol = Solve[Flatten[ {Table[ Sum[Sin[j Pi i/(n + 1.)] a[j], {j, n}] == =CE=B4initialPositions[[i]] , {i, n}], Table[Sum[ef[[j]] Sin[j Pi i/(n + 1.)] b[j], {j, n}] == initialVelocities[[i]], {i, n}]}], Flatten[Table[{a[i], b[i]}, {i, n}]]]; =CF=88s[t_] = Table[i + Sum[Sin[j Pi i/(n + 1.)] (a[j] Cos[ef[[j]]t] + b[j] Sin[ef[[j]] t]), {j, n}] /. sol, {i, n}] // Chop; tab = Quiet@ Table[ L = Flatten[{0, =CF=88s[kt T/m], n + 1}]; {spring[#, kt/m (n + 1) , 1/ (m + 1)] & /@ Partition [L, 2, 1], {Gray, Disk[{#, kt/m (n + 1) }, =CE=BB] & /@ Take[L, {2, -2}]}, {Gray, Rectangle[{0, kt/m (n + 1)} - =CE=BB, {0, kt/m (n + 1)} + =CE=BB], Rectangle[{n + 1, kt/m (n + 1)} - =CE=BB, {n + 1, kt/m (n + 1)} + =CE=BB]}}, {kt, 0, m }]; Graphics[tab, PlotRange -> All, Frame -> False, FrameTicks -> None, ImageSize -> {350, 350}] ]; Manipulate[makePicture[Sequence @@ Transpose[{xv1, xv2, xv3}], m, T] , {{T, 10, "maximal time"}, 0.01, 100, Appearance -> "Labeled"}, {{m, 24, "number of time slices"}, 1, 50, 1, Appearance -> "Labeled"}, {{xv1, {0.2, 0}, "initial\nposition/velocity mass 1"}, {-0.5, -0.5}, {0.5, 0.5}, ImageSize -> Small}, {{xv2, {0.0, 0}, "initial\nposition/velocity mass 2"}, {-0.5, -0.5}, {0.5, 0.5}, ImageSize -> Small}, {{xv3, {0., -0.1}, "initial\nposition/velocity mass 3"}, {-0.5, -0.5}, {0.5, 0.5}, ImageSize -> Small}, ControlPlacement -> {Top, Top, Left, Left, Left}, SaveDefinitions - > True, AutorunSequencing -> {3, 4, 5}] On Aug 30, 2008, at 12:51 AM, Caroling Geary wrote: > A Polygon can be colored but could I animate each face of a > tetrahedron? I'd like columns of 0s and 1s to stream across each > face. It could just be the front faces. The tetrahedron doesn't have > to rotate in 3D (although that would be nice). > I have a trial version of Mathematica and want to do art with it. > I've modified a Demonstrations Project. I can script and figure > things out but I'm not sure that what I envision can actually be done > in Mathematica. > > Caroling Geary, www.wholeo.net > > Caroling Geary, www.wholeo.net
- References:
- animated faces of polygon
- From: Caroling Geary <caroling@mchsi.com>
- animated faces of polygon