[Date Index]
[Thread Index]
[Author Index]
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
Prev by Date:
**Re: Re: Mathematica and F#**
Next by Date:
**Re: light-weight PC to run Mathematica?**
Previous by thread:
**animated faces of polygon**
Next by thread:
**I am having some problem manipulating mathematica expressions**
| |