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" ...


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,...


15

EDIT 1. Fixed kernel crashing. The problem was WhenEvent choking, because it was continually checking whether the current pivot (which lies exactly on the bounding circle) goes outside the bounding circle. EDIT 2. Here is a port to GNU Octave: https://github.com/yawnoc/tumbling-polygon System of ODEs in the complex plane For a completely different take, ...


12

1. You can use HorizontalGauge as a control in Manipulate: Manipulate[Plot[Sin[x + phi], {x, 0, 2 Pi}], {phi, 0, 2 Pi, Panel[HorizontalGauge[##, ScaleDivisions -> None, Axes -> {True, False}, ImageSize -> 250, Ticks -> {Transpose[{Subdivide[8], Subdivide[0, 2 Pi, 8]}], None}], #, Right] &}] To allow only discrete values, say ...


10

To replicate the dancy plot with fake data: hino = RandomWord["Noun", 50]; lpdata = RandomInteger[150, 26]; frames = Table[TableForm[{{TableForm[{{Style[RandomInteger[500], "Title", 16], Style[hino[[i]], "Title"]}}, TableAlignments -> Center]}, ListPlot[lpdata, AxesOrigin -> {0, 0}, PlotRange -> {{...


9

Another elegant solution is to simply take your full parameteric plot: g = ParametricPlot3D[Evaluate[{x, y, z}], {t, 0, 100}, PlotRange -> 1, BoxRatios -> {1, 1, 1}, AxesLabel -> {X, Y, Z}]; Extract the points and then use this sweet ResourceFunction from Jon Mcloone: pts = Cases[g[[1]], Line[pts_, rest___] :> pts, \[Infinity]][[1]]...


9

You could try adding ImagePadding and AxesEdge to prevent the axes from jumping around. f = Table[ Plot3D[(1 + Sin[2 π t]) E^(-(x - Sin[2 π t])^2 - (y - Cos[2 π t])^2), {x, -2, 2}, {y, -2, 2}, PlotLabel -> t, PlotRange -> All, ViewPoint -> {-2, -2, 1}, ImagePadding -> {{40, 0}, {0, 0}}, AxesEdge -> {{-1, 1}...


7

You need I.C., so made one for you. Feel free to change it. I also changed your notation to make it more common. The dependent variable is $u(x,t)$ and the space variable is $x$. In both solutions below, this initial conditions is used To make it consistent with boundary conditions. Feel free to change it. Solve for $u(x,t)$ with $t>0, 0<x<L_0$ ...


7

This can be done with just a couple lines and pretty quickly. First define your ODE and your system parameters ode = ϕ''[t] + g/l Sin[ϕ[t]] == 0; params = Table[{g -> 9.81, l -> 11 - a}, {a, 1, 10}]; Make a Table of all the numerical solutions: sols = Table[NDSolve[Evaluate[{ode, ϕ'[0] == 0, ϕ[0] == π/4} /. params[[i]]], ϕ[t], ...


7

m = 20; Animate[ArrayPlot[ArrayPad[CellularAutomaton[20, {{1}, 0}, {n, All}], {{0, m - n}, {m - n, m - n}}], Mesh -> True], {n, 0, m, 1}, AnimationRunning -> False]


7

If anyone wants to build on top of this answer, feel free. We start by draw the Lorentz attractor: solutions[tmax_] := NDSolveValue[{ x'[t] == -3 (x[t] - y[t]), y'[t] == -x[t] z[t] + 26.5 x[t] - y[t], z'[t] == x[t] y[t] - z[t], x[0] == z[0] == 0, y[0] == 1 }, {x, y, z}, {t, 0, tmax} ] {xsol, ysol, zsol} = solutions[100]; plot[tend_, ...


6

Circles are really 2D objects, unfortunately you can't use them on Graphics3D like that. You can start with this: Table[ Graphics3D[ Table[{Hue[h], Rotate[Tube@Table[h {Sin[t], 0, Cos[t]}, {t, 0, 2 Pi, Pi/50}], u h, {0, 0, 1}]}, {h, 1/20, 1, 1/20}], Lighting -> {{"Ambient", White}}, ViewPoint -> Front, ViewAngle -> 30 ...


6

Use ListAnimate. Also, you can make your path generation a bit simpler with AnglePath and your bounds are not correct as Min/Max will read from any coordinates, so I've used BoundingRegion instead: pt = AnglePath[RandomReal[{0, 2 Pi}, 1000]]; bbox = Transpose[BoundingRegion[pt] /. Cuboid -> List]; ListAnimate[ ListLinePlot[Take[pt, #], PlotRange -> ...


6

There are some examples of how to control the camera in the downloadable notebook of the Wolfram U tutorial Dynamic Visualization in the Wolfram Language. You probably want to use a combination of ViewVector, ViewVertical, and ViewAngle to control the camera. Use ViewVector to view ahead and ViewVertical to orient the camera. In the example below, I set ...


6

A general approach using Graphics3D[] and surf[] (below, built with NDSolve): rr[t_] := {Cos[t], Sin[t]}; ht[t_] := 2 + Cos[t]; Manipulate[ Graphics3D[{EdgeForm[], surf[traj[rr, {0 &, ht}, {t, 0, 2 Pi}, 2 Pi - t0]]}, BoxRatios -> Automatic, PlotRange -> {{-1.55 Pi, 2.05 Pi}, {-1.55 Pi, 2.05 Pi}, {-0.1, 3.5}}], {t0, 0., 2 Pi}] A fancier ...


5

You can use ParametricNDSolveValue to create a list of parametric interpolation functions using A as the parameter: pndsv = ParametricNDSolveValue[{m*x''[t] == ((((m*g)/l)*(l/2 - (x[t]))*k[t]* u) - (((m*g)/l)*(l/2 + (x[t])))*j[t]*u), WhenEvent[x[t] == 0, {Tn[t] -> t, V0[t] -> Abs[x'[t]]}], WhenEvent[t == Tn[t] + ((3.14*(2*l/(u*g))^0.5)...


5

You can use PadRight and PadLeft to pad the matrix with zeroes. One possible solution is Module[{rule = 20, max = 20, ca}, ca = CellularAutomaton[rule, {{1}, 0}, {max, All}]; Animate[ ArrayPlot[ (* Display only the first n rows of ca and pad the rest with zeroes *) PadRight[ca[[;; n]], {max + 1, 2 max + 1}], Mesh -> True ], {n, 1, max, 0}, ...


4

It's possible with some amount of effort. The key is to make separate plots of the surface without the meshlines, and a plot with just the meshlines. Since the OP did not bother to put in example code, I wrote up the following: p1 = ParametricPlot3D[{(3 + Cos[u]) Cos[v], (3 + Cos[u]) Sin[v], Sin[u]}, {u, -π, π}, {v, -π, π}, Lighting -&...


4

Add Bookmarks: anim = Animate[Plot[Sin[x + a], {x, 0, 10}], {a, 0, 5}, Bookmarks -> {"start" :> {a = 0}, "stop" :> {a = 5}}]; Export["animation.gif", anim]


4

As noted by @xzczd, the $t$ is already hardwired into your definition of $x$, so you can't use the expression x[t]. The correct expression is just x, as in your Plot[x, ...] commands. I think this is where you are trying to go, more or less ListAnimate[Table[ p = ParametricPlot3D[Evaluate[{x, y, z}], {t, 0, tmax}]; g = Graphics3D[{Red, Arrowheads[0.1],...


4

Inspired by SHuisman, using complex number Manipulate[ Graphics[{ Table[With[{k = Mod[i + j, 2]}, {EdgeForm[Gray], RGBColor[k, 1 - k, 0, .2], Polygon@ReIm[(1 + I) (E^(I θ) + I) (i + I j) + E^(I k θ) {-1-I, I-1, 1+I, 1-I}]}], {i, -n, n}, {j, -n, n}] }, PlotRange -> 4 n + 2 ], {{n, 3}, 1, 9, 1}, {θ, 0., Pi}]


4

I'm not sure if this is what you're looking for based on the code shown. My interpretation of the text of your question would be something like this: Animate[ Plot[ x^2, {x, -1, 1}, Epilog -> { AbsolutePointSize[8], Point[{Sin[t], Sin[t]^2}] } ], {t, 0, 2 Pi} ] If the position of the ball should be $x = \sin(t)$, then ...


4

After some experiments I got similar picture, but final animation is too large for this forum. So I have created small animation just to show a principle of visualization. First we have created all needed vectors L = NDSolveValue[{x'[t] == -3 (x[t] - y[t]), y'[t] == -x[t] z[t] + 26.5 x[t] - y[t], z'[t] == x[t] y[t] - z[t], x[0] == z[0] == 0, y[0] ==...


4

The problem here is the way the replacements are made. ODE is a replacement rule that looks like: {{x[t] -> 1 + t}} The Manipulate effectively tries to evaluate something like the following (for some value of t you selected): DynamicModule[{t = 10}, ListPlot[{{x[t] /. ODE, 0}}]] The problem here is that during the evaluation, x[t] first gets evaluated ...


4

For version V12.1. I couldn't figure out a way to get VectorScaling to do anything except the limited options listed in the docs. (The old VectorScale seemed simultaneously more versatile and inscrutable.) interp[p_, q_, s_] := ( p (1 - s) + q (1 + s))/2; Manipulate[ VectorPlot[{Cos[t]*(-y), Cos[t]*x}, {x, -1, 1}, {y, -1, 1}, VectorScaling -> ...


4

If you'd like to convert your 2D unrolling a circle process to 3D, you could do the following: Manipulate[ ParametricPlot3D[ If[ϕ < θ, {ϕ + Sin[θ - ϕ], 1 - Cos[θ - ϕ], z (2 + Cos[θ])}, {θ, 0, z (2 + Cos[θ])}], {θ, 0, 2 π}, {z, 0, 1}, PlotRange -> {{-1, 7}, {-1, 2}}, PlotStyle -> Directive[Opacity[0.5], Blue], Mesh -> {101, 2}, ...


4

SetOptions[ParametricPlot3D, Boxed -> False, Axes -> None, ImageSize -> Large, PlotStyle -> Directive[Opacity[0.5], Blue], PlotRange -> {{-8, 8}, {-8, 8}, {0, 5}}, ViewProjection -> "Orthographic"]; r[s_] = {Cos[s], Sin[s]}; f[θ_, s_] := If[0 <= θ <= s, r[θ], r[s] + (θ - s)*Normalize[r'[s]]]; h[θ_] = 2 + Cos[...


3

Silvia already gave a pretty rigorous derivation (compare this with the treatment by Hall and Wagon), so let me show how to plot the desired trajectory of the rolling polygon's corner. One could certainly modify the code I gave here for this, but I will instead adapt this solution I previously wrote in OpenGL to Mathematica: With[{n = 4}, (* number of sides ...


3

Using Modelica for System Dynamics The way to go for doing System Dynamics (i.e. continuous time, equation based simulations describing the changes of a system's states by flows—essentially reducing a system of higher order ODEs to a system of first-order ODE) within the Wolfram universe is to turn to System Modeler which is built upon Modelica—a simulation ...


3

I'm trying to numerically solve a system of differential equations describing two pendula connected to each other by a spring, and then make an animation of their evolution in time Here is something to get you started. You can do all this in Mathematica directly by solving the equations of motion and then use NDSolve to solve them and then do the ...


Only top voted, non community-wiki answers of a minimum length are eligible