94
TL;DR: A package (Mathematica v10) can be found at the very bottom of this post.
UPDATES
6: Tiny update: Import can now use the ".bvh" extension to determine the import type. The code that does this is ugly, but I don't see any other way at the moment.
out = Import["C:\\Female1_C03_Run.bvh"]
5: Added error checking and registered the package as an ...
answered Sep 29 '14 at 21:38
Sjoerd C. de Vries
63.9k14 gold badges177 silver badges314 bronze badges
68
Edit: Added the reversal and some refinements
ω = 1;
posP[t_, φ_] := Sin[ω t + φ] {Cos[φ], Sin[φ]}
posL[φ_] := {-#, #} &@{Cos[φ], Sin[φ]}
Animate[
Graphics[{PointSize[0.02],
Table[{Black, Line[posL[π i]], Hue[i], Point[posP[t, π i]]}, {i, 0, 1, 1/(3π-Abs[9.43-t])}]
},
PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}
],
{t, 0, 6π, 0.2}
]
67
I'd like to expand on Quantum_Oli's answer to give an intuitive explanation for what's happening, because there's a neat geometric interpretation. At one point in the animation it looks like there is a circle of colored dots moving about the center, this is a special case of so called hypocycloids known as Cardano circles. A hypocyloid is a curve generated ...
55
After correcting the syntax errors in the original code, the actual question can be addressed:
How to display the four variables x1[t]...y2[t] as an animation in a way that conveys their meaning? The basic idea is to use ListAnimate on a list of frames that I define below:
Clear[phi1, phi2, t];
sol = First[
NDSolve[{2*phi1''[t] + phi2''[t]*Cos[phi1[t] - ...
50
A textbook-like animation
turns = 10;
aa = Table[Framed@
Show[ParametricPlot3D[
Piecewise[{{{1, x, 0}, x <= 0},
{{Cos[2 Pi turns x/r], x, Sin[2 Pi turns x/r]}, 0 < x <= r},
{{1, x, 0}, x > r}}],
{x, -.5, r + .5},
PlotStyle -> {Gray, Specularity[Gray, 10]}, Lighting -&...
42
Usage
Just use this function with any polyhedron in in form:
GraphicsComplex[pts_, Polygon[vertices_, ___]].
When I find time and motivation maybe I will add more DownValues so it can be more general.
At the moment you can play with solids given by PolyhedronData[... "Faces"]:
polyhedronRandomWalk[
PolyhedronData["DuerersSolid", "Faces"]
]
It should ...
42
MMA version: 12.0
I'll use the following images, found on the internet under open licence (if you know how to share the images themselves, please let me know). I originally had chosen two more but feature extraction did not work appropriately. I already rescaled them by chosing scaling factor such that the area of the triangle "left eye - right eye - mouth" ...
41
Edit I had some time so I've added full surface torus. Old code in edit history.
DynamicModule[{x = 2., l = 100., x2 = 2., l2 = 100., grid, fast, slow},
Grid[{{
Graphics3D[{
Dynamic[Map[{Blue, Polygon[#[[{1, 2, 4, 3}]]]} &,
Join @@@ (Join @@ Partition[#, {2, 2}, 1])
]&[
...
41
This is not the full answer but I've solved most of the problems. The hardest one, with sound, remains.
Embedded version without music
bobthechemist's points
Quality is not a problem anymore since here nothing is rasterized.
White edges are due to "features" with Texture, I've fixed that using strange VertexTextureCoordinates.
I can't handle this ...
38
Edit V10!
This is simple example what we can now do in real time!
R = RegionUnion @@ Table[Disk[{Cos[i], Sin[i]}, .4], {i, 0, 2 Pi, Pi/6.}];
R2 = RegionBoundary@DiscretizeRegion@R;
go[] := (While[r > .105, x += v; r = RegionDistance[R2, x]; Pause[.01]]; bounce[];)
bounce[] := With[{normal = Normalize[x - RegionNearest[R2, x]]},
If[break, Abort[]];
v ...
38
DynamicModule[{t = 0, d = 5, a = .08, base, distortion, pts, r, f, n = 10},
r[y_] := .08 y^4;
f[x_] := -2 Pi Dynamic[t] + d x;
(*f does not evaluate to a number but FE will take care of that later*)
base = Array[List, n {3, 1}, {{0, Pi}, {0, 1}} ];
distortion = Array[
Function[{x, y}, r[y] {Cos @ f @ x, Sin @ f @ x}], n {3, 1}, {{0, Pi}, {0, 1}} ...
29
I think you might be better off creating Graphics directly instead of using the StreamPlot style options. In this example I use StreamPlot just once and extract the coordinates of the arrows, which I use to create Line objects with VertexColors. The animation is made by cycling the vertex colors.
plot = StreamPlot[{-1 - x^2 + y, 1 + x - y^2}, {x, -3, 3}, {y,...
28
Read comments to your post - many good links there. Additionally, are a few thoughts on the topic.
1) Avoid PPT, - use built-in Mathematica slideshow templates, they were recently updated and are beautiful. Advantage is - you preserve computations and native graphics (like rotations in 3D, etc.). You can read more in this post: Best way to give ...
28
Since you want the animation to have explanatory content, I thought it might be best to incorporate the explanatory 2D diagram into the 3D scene.
So I imagine the 2D plot as a "sticker" that can be put onto the cylinder, like a label on a bottle. That way, you can see the explanatory diagram itself wrap around the cylinder and become identical to the ...
28
This is my port of the Processing code that you referenced. It doesn't try to optimize, so I didn't try it either, for example I didn't use Nearest to find collisions even though that would be fast since it uses a quadtree. I found that I didn't need those optimizations to recreate the animation on the previously linked to website.
About your questions:
1) ...
27
Let's get a black torus:
torus = First@ParametricPlot3D[{Cos[u] (3 + Cos[t]), Sin[u] (3 + Cos[t]), Sin[t]},
{u, 0, 2 Pi}, {t, 0, 2 Pi},
PlotStyle -> Black, Mesh -> None, PlotPoints -> 10]
and now, this is a way to go:
DynamicModule[{d1 = 0, d2 = 0},
Column[{
Graphics3D[{
torus,...
27
Embedded cdf with music version. code at the bottom
For full period, change max t to 200, my gif is cut in half because for some reasons I couldn't upload whole.
f[r_, t_] := Mod[-t (1 - r), 2. Pi];
dr = Pi /100.
Animate[Graphics[{
Table[{
AbsolutePointSize[10 # + 2 + 2 Unitize@Clip[f[#, t] - 5.5, {0, 1}]],
Blend[{Blend["...
27
Generally always check Demonstrations site for good code. I cannot not mention an excellent "classic" of planar three body problem by Stephen Wolfram and Michael Trott. Code is short and I verified it runs in the latest M10.1. I slightly changed variable labels so code parses better here, removed MaxRecursion -> ControlActive[3, 9] from plot option and ...
26
The following is a little involved, but it calculates the "minimum displacement" evolution by choosing the least total displacement alternatives from the permutations generated by the "AutomorphismGroup" of the graph:
{n, edges, coords1, perms} = GraphData["PappusGraph", {"VertexCount", "EdgeList",
"...
26
As partly mentioned in this: Add delay to the final frame of a GIF? we can use "AnimationRepetitions" -> ∞ to loop a GIF indefinitely:
Export["C:\\Users\\Ali Hashmi\\Desktop\\test.gif", gif, "AnimationRepetitions" -> ∞]
25
Somewhat belatedly, here is a version that starts from random points and slowly coalesces into the logo.
Begin with the logo from the blog entry which is here called img, and apply a jitter filter which randomizes the position of each pixel within a region of specified size. By starting with a large region (100 pixels by 100 pixels) and shrinking down to 1 ...
24
data generates n balls, here: 10
Note that it might be wise to make the box larger, if different WhenEvent[]s happen at the same time (both box and ball collision), one can overwrite the other.
data = Table[{RandomReal[{-0.85, 0.85}, {3}],
RandomReal[{-1, 1}, {3}],
RGBColor[RandomReal[{-1, 1}], RandomReal[{-1, 1}],
RandomReal[{-1, 1}]]}, {i, 10}];
I'...
24
This question is too interesting to resist, so I'll talk about how to analyze the problem.
Take a look at sketch above. It describes an arbitrary moment during the rolling. From the kinematics view, $P$ is the "instant center of rotation". From the energy view, the square's center of mass $O$ keeps its height, thus the potential of the square doesn't change,...
23
Some frames from my version of the animation:
Here's the code I used:
orbit[posStart_?VectorQ, derStart_?VectorQ] :=
Block[{c = -Rationalize[6.672*^-11*7*^17], x, y, z, t},
{x, y, z} /. First @ NDSolve[
Join[Thread[{x''[t], y''[t], z''[t]} ==
c {x[t], y[t], z[t]}/Norm[{x[t], y[t], z[t]}]^3],
...
23
Thanks to J.M.
drop = SetAlphaChannel[#, ColorNegate@#] &@
Binarize@Rasterize@
ParametricPlot[{r Cos[t] (1 - Sin[t]), -3 +
r (5/2 (Sin[t] - 1) + 3)}, {t, 0, 2 Pi}, {r, 0, 1},
BoundaryStyle -> None, Axes -> False, Frame -> False]
Something to start with:
circle = Table[
Translate[
Point[{##, 0} & @@@ CirclePoints[...
22
You have to set values which are dynamic in Manipulate.
μ = .75; ω = .75; A = .075; xv0 = {1, 1};
Table pictures for different tt:
sol = Quiet@NDSolve[{x'[t] == v[t], v'[t] == μ (1 - x[t]^2) v[t] - x[t] + A*Cos[ω*t],
x[0] == xv0[[1]], v[0] == xv0[[2]]
}, {x[t], v[t]}, {t, 0, 20}];
dat = Table[
...
22
Here is an approach.
rws[n_, p0_?(Norm@# == 1 &), ang_] :=
NestList[RotationMatrix[ang/(2 Pi),
(Function[{u, v}, {Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]}] @@
RandomReal[{0, 2 Pi}, 2])].# &, p0, n]
Visualizing:
Graphics3D[{Sphere[], Line[rws[10000, {1, 0, 0}, 1]]}, Boxed -> False]
22
What has changed in Mathematica since version 2 so that Do no longer can be used to make animations?
There was a major overhaul of graphics in 2007 for V6, one aspect of which was that Mathematica switched from displaying graphics as a side-effect, to rendering directly in the notebook.
Since graphics are no longer a side effect, Do doesn't display the individual plots anymore.
Additionally, the interface to run the animation has been removed, at least on ...
21
If you interpret your geometric shape as a NURBS of degree 1 (linear), you can proceed with the following, extremely simple code:
pts = {{0, 0}, {1, 1}, {0.5, 1.5}}; (* just an example *)
s = BSplineFunction[pts, SplineClosed -> True, SplineDegree -> 1];
Animate[ParametricPlot[s[t], {t, 0, 1}, Epilog :> {Red, PointSize[Large], Point[s[t]]}], {t, 0.,...
21
EDIT
As OP wishes (and as Rahul correctly points out) my original answer puts unit circle in TB plane (my error as labels suggest) and what is desired is TN plane.
pp = ParametricPlot3D[r[t], {t, 0, 2 \[Pi]}]
fs = FrenetSerretSystem[r[t], t];
tan[s_] := fs[[2, 1]] /. t -> s
nrm[s_] := fs[[2, 2]] /. t -> s
cir[u_] :=
Table[r[u] + Cos[j] tan[u] + (...
Only top voted, non community-wiki answers of a minimum length are eligible
