Skip to main content

graphics - Animating a rotating disk


I have a system with 3 degrees of freedom that I want to know if it is possible to visualise with Mathematica in the two-dimensional $X-Y$ plane. I have a plane circular object rotating at its set speed say $10$ deg/s. This object is not rotating at the $(0, 0)$ origin point but is displaced from the origin $(0, 0)$ coordinates and its motion path is described by


$x=x_0 + a \times \cos(\omega \: t)$ and $y=a \times \sin(\omega \: t)$


Some values: $x_0 = 1$ mm; $a=0.25$ mm, $\omega=10$ deg/s (same as the rotating speed of the circular object). The radius of the circular object can be taken to be a couple of cm say $2$ cm.


The time parameter $t$ in the parametric equations can be discretised in $20$ steps as follows:


$\mathrm{step}= \frac{360 \; \mathrm{deg}}{\omega \times 20} = \frac{360}{10 \times 20}=1.8$ s


so that $\mathrm{step}$ will take values $0$, $1.8$, $3.6$, $\ldots$, $34.2$ s.


Thus the product $\omega \: t$ as the cosine and sine arguments of the parametric path can be written as



$\omega \: t = \omega \times \frac{\mathrm{step \times \pi}}{180}$


which in units gives $\frac{\mathrm{deg}}{\mathrm{seconds}} \times \frac{\mathrm{seconds} \times \mathrm{radians}}{\mathrm{deg}} = \mathrm{radians}$.


Any help will be appreciated to this Mathematica newbie on how to go about to simulate this kind of motion. Desired animation fatures:




  1. Perhaps the circular object can have hatched shading so that its rotating motion can be seen on top of its following the parametric circular path;




  2. The $x-$ and $y-$axes should be visible;





  3. The parametric path given by the parametric equations in $x$ and $y$ should be visible as a circle.





Answer



Lets start with some parameters (note that I've chosen larger values for a and x0 here to actually see the movement of the centre)


radius = 20;
x0 = 10;
a = 5;
om1 = 10 Degree;

om2 = 10 Degree;

The centre of the rotating object at time t is given by


centre[t_] := {x0 + a Cos[om1 t], a Sin[om1 t]};

I'm using RegionPlot to create an image of the disk centred at the origin


circ = RegionPlot[x^2 + y^2 <= radius^2, {x, -radius, radius}, 
{y, -radius, radius},
Mesh -> 20, MeshStyle -> {{Red}, {Blue}}, BoundaryStyle -> Black,
PlotStyle -> None]


Mathematica graphics


Next, we're defining a function for creating the plot at time t. I'm using Rotate and Translate to get the orientation and position of the disk. The path of the centre is plotted using ParametricPlot


plot[t_] := Show[Graphics[
Translate[Rotate[{circ[[1]], Point[{0, 0}]}, om2 t], centre[t]]],
If[Abs[t] <= $MachineEpsilon, {},
ParametricPlot[centre[s], {s, 0, t}, PlotStyle -> {Black}]],
PlotRange -> {{-2 radius, 2 radius}, {-2 radius, 2 radius}},
Axes -> True]


Plugging this function into Animate will create an animation of this function:


Animate[plot[t], {t, 0, 36}]

Mathematica graphics


Comments

Popular posts from this blog

plotting - Filling between two spheres in SphericalPlot3D

Manipulate[ SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, Mesh -> None, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], {n, 0, 1}] I cant' seem to be able to make a filling between two spheres. I've already tried the obvious Filling -> {1 -> {2}} but Mathematica doesn't seem to like that option. Is there any easy way around this or ... Answer There is no built-in filling in SphericalPlot3D . One option is to use ParametricPlot3D to draw the surfaces between the two shells: Manipulate[ Show[SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], ParametricPlot3D[{ r {Sin[t] Cos[1.5 Pi], Sin[t] Sin[1.5 Pi], Cos[t]}, r {Sin[t] Cos[0 Pi], Sin[t] Sin[0 Pi], Cos[t]}}, {r, 1, 2 - n}, {t, 0, Pi}, PlotStyle -> Yellow, Mesh -> {2, 15}]], {n, 0, 1}]

plotting - Plot 4D data with color as 4th dimension

I have a list of 4D data (x position, y position, amplitude, wavelength). I want to plot x, y, and amplitude on a 3D plot and have the color of the points correspond to the wavelength. I have seen many examples using functions to define color but my wavelength cannot be expressed by an analytic function. Is there a simple way to do this? Answer Here a another possible way to visualize 4D data: data = Flatten[Table[{x, y, x^2 + y^2, Sin[x - y]}, {x, -Pi, Pi,Pi/10}, {y,-Pi,Pi, Pi/10}], 1]; You can use the function Point along with VertexColors . Now the points are places using the first three elements and the color is determined by the fourth. In this case I used Hue, but you can use whatever you prefer. Graphics3D[ Point[data[[All, 1 ;; 3]], VertexColors -> Hue /@ data[[All, 4]]], Axes -> True, BoxRatios -> {1, 1, 1/GoldenRatio}]

plotting - Adding a thick curve to a regionplot

Suppose we have the following simple RegionPlot: f[x_] := 1 - x^2 g[x_] := 1 - 0.5 x^2 RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}] Now I'm trying to change the curve defined by $y=g[x]$ into a thick black curve, while leaving all other boundaries in the plot unchanged. I've tried adding the region $y=g[x]$ and playing with the plotstyle, which didn't work, and I've tried BoundaryStyle, which changed all the boundaries in the plot. Now I'm kinda out of ideas... Any help would be appreciated! Answer With f[x_] := 1 - x^2 g[x_] := 1 - 0.5 x^2 You can use Epilog to add the thick line: RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}, PlotPoints -> 50, Epilog -> (Plot[g[x], {x, 0, 2}, PlotStyle -> {Black, Thick}][[1]]), PlotStyle -> {Directive[Yellow, Opacity[0.4]], Directive[Pink, Opacity[0.4]],