89
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
61.5k12 gold badges166 silver badges305 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}
]
65
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 ...
57
Let me join.
logo = Cases[
p7 /. triangulate /. moretriangles /. shrink /. shrink /. shrink /. colour3[] /. colour4["SunsetColors", 1, 28/34] , {c__, Polygon[pts__]}, \[Infinity]];
logo = SortBy[logo, First];
p = Evaluate[InterpolatingPolynomial[{
{0, {0, 0, 0, 0}}, {Pi, {Pi, 0, 0, 0, 0}}, {2 Pi, {2 Pi, 0, 0, 0}}},#]] &;
pp[a_] := If[Abs[a - Pi] ...
55
The idea behind this solution is to construct a superposition of Gaussian surfaces whose amplitude decay in time, and use DensityPlot to plot the trail:
trail[fun_, {t_, tmin_, tmax_, dt_}, k_, lam_][xxx_, yyy_] :=
Module[{trange, xrange, yrange, twindow, trailf, sel, decayf},
decayf[x0_, y0_, t0_] := Exp[-k t0 - lam^2 (x0^2 + y0^2)];
twindow = 6/k;
...
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] - ...
51
Here is a simple approach to create a ghost trail:
obj[{xfunc_, yfunc_}, rad_, lag_, npts_][x_] := MapThread[
{Opacity[#1, ColorData["SunsetColors", #1]],
Disk[{xfunc@#2, yfunc@#2}, rad Exp[#1 - 1]]} &,
Through[{Rescale, Identity}[Range[x - lag, x, lag/npts]]]]
frames = Most@Table[Graphics[obj[{Sin[2 #] &, Sin[3 #] &}, 0.1, 1, 500][u],
...
51
Breathing with occluded borders, per Toad's request:
Run the following command to get the Mathematica code
NotebookPut@ImportString[Uncompress@FromCharacterCode@Flatten@ImageData[
Import@ "http://i.stack.imgur.com/VqjJ9.png","Byte"],"NB"]
50
My simple version using Image:
size = 300;
r = ListConvolve[DiskMatrix[#],
RandomInteger[BernoulliDistribution[0.001], {5 size, size}], {1, 1}] & /@ {1.5, 2, 3};
Dynamic[Image[(r[[#]] = RotateRight[r[[#]], #]) & /@ {1, 2, 3}; Total[r[[All, ;; size]]]]]
Update
A slightly prettier version, same basic idea but now with flakes.
flake := Module[{...
49
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 -&...
46
My approach. The main distinguishing feature being the ridiculously clumsy and inefficient way of calculating the faces...
v = Tuples[{-1, 1}, 4];
e = Select[Subsets[Range[Length[v]], {2}], Count[Subtract @@ v[[#]], 0] == 3 &];
f = Select[Union[Flatten[#]] & /@ Subsets[e, {4}], Length@# == 4 &];
f = f /. {a_, b_, c_, d_} :> {b, a, c, d};
rotv[...
45
Note that ViewPoint is given in specially scaled coordinates which depend on amongst things the size of the bounding box. To get better control over the positioning of the camera you could use ViewVector instead, which is given in terms of the coordinates of the plot. You could for example do something like this:
rotateMeHarder1[g_, vertical_, viewpoint0_, ...
44
The first step is to rasterize the points, so let's just start there as an example:
n = 512;
g = Image[Map[Boole[# > 0.001] &, RandomReal[{0, 1}, {n, n}], {2}]]
The trick is to exploit the distance image. Almost all the work is done here (and it's fast):
i = DistanceTransform[g] // ImageAdjust // ImageData;
We need a little more precomputation of ...
42
As per the blog:
Export["breathing.gif", Table[Graphics[
p7 /. triangulate /. moretriangles /. shrink /. shrink /. shrink /. colour3[] /.
colour4["SunsetColors", 1, 28/34] /. curve /. bolicsn[(1 - Cos[2 \[Pi] t])/2],
ImageSize -> 150], {t, 0, 1, 0.05}]];
Some good old fashioned colour cycling:
Clear[f];
f[c_] /; c > 2 := c - 2;
f[c_] /; c ...
41
Who wanted the automagic? :)
mmastar[as_, nn_: 1] := Graphics[
Scale[#, 1/max@#, {0, 0}] &[
Polygon[pt /@ as] /. triangulate /. moretriangles /. shrink /.
shrink /. shrink /. colour3[] /. colour4[] /. curve /.
bolicsn[nn]], AspectRatio -> Automatic, PlotRange -> 0.025];
da = 0.0001;
max[zu_] :=
Cases[zu, {_?NumericQ, _?...
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 song ...
39
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])
]&[
...
38
Here is an example of how to create an animation from DensitPlot results. I have chosen a simple Gaussian function to plot, but its center depends on a parameter t. Now I create a table of plots for many different values of t, and then I take several different steps to create various kinds of movies from it. The parameter t and its step size is going to be ...
38
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 ...
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}} ...
36
Load some images:
size = {200, 200};
foot = ImageResize[Import[
"http://upload.wikimedia.org/wikipedia/commons/a/ab/Monty_python_foot.png"
], size];
spikey = ImageResize[Import[
"http://upload.wikimedia.org/wikipedia/en/b/bf/MathematicaSpikeyVersion8.png"
], size];
mse = ImageResize[Import[
"http://i.stack.imgur.com/yjrEY.png"
], size];
Crop ...
36
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[]];
...
35
Here is my (slightly less) modest attempt to depict the Clifford rotation (a.k.a. double rotation) of a hypercube, using perspective projection (i.e., a Schlegel diagram) to view the rotation (see this for a discussion on perspective projection):
tesseract = GraphicsComplex[
{{-1, -1, -1, -1}, {-1, -1, -1, 1}, {-1, -1, 1, -1}, {-1, -1, 1, 1}, {-1, 1, -1, ...
answered Aug 18 '12 at 15:05
32
Here's a spinning "3D version" of the logo
Using the code from meta/blog to create the logo (assigned to the variable logo), continue with the following steps:
side[o_] := Block[{z, pts = Partition[
Table[N[{Cos[t], Sin[t], z}], {t, Pi/14, 2 Pi, 2 Pi/7}], 2, 1, 1]},
Composition[Polygon, Flatten[#, 1] &] /@ Thread[{pts /. z -> o/2, Reverse /@ ...
32
I happened to create some snowflakes and snow fall a couple weeks back, and its nice to have some place to share with others!
First, we create some algorithmically generated snowflakes with some randomness using a kind of iterated function system based off the 6-pointed "star" shown below.
H = Table[{Cos[n*Pi/3], Sin[n*Pi/3]}, {n, 0, 5, 1}];
Graphics@...
30
Here you have a toy to start playing with:
Edit preventing the animation running at different speeds in different machines by using Clock[] and DynamicWrapper[] (due credit to @jVincent)
n = 500; (*number of managed particles*)
x[i_][t_] := (vx0[i] (t - delay[i])) UnitStep[t - delay[i]];
y[i_][t_] := Module[{k}, If[(k = (-#^2 + vy0@i #) UnitStep@#) < ...
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
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 ...
27
Here's my contribution. I know you asked for hints only, but I couldn't resist
text = Style["This is some text on a Möbius strip",
FontFamily -> "Helvetica", FontSize -> 35];
img = ImageData@Image[Rasterize[text, Background -> None, ImageSize -> 1000]];
Manipulate[
ParametricPlot3D[{4 Cos[a] + r Cos[a] Cos[a/2],
4 Sin[a] + r Sin[a] Cos[...
27
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 ...
Only top voted, non community-wiki answers of a minimum length are eligible
