Tag Info

New answers tagged

2

The basic idea, where you can adjust the function, limits, and Piecewise arguments for your specific case. Manipulate[ Plot[{120 - 50 x^2, 120 - 50 Sqrt[x]}, {x, 0, 1}, PlotRange -> {70, 120}, Filling -> {1 -> {2}}, PlotStyle -> {Green, Blue}, FillingStyle -> LightGray, Epilog -> {Red, PointSize[0.03], Point[{.5, ...


5

I'll provide an starting point for 2D case with single particle. Collisions with other particles are likely to be hard to model (or at least require adding an massive amount of WhenEvent rules if implemented this way), since NDSolve and WhenEvent tend to miss discrete events. Also, 3D case would be considerably more complicated to build; likely to take more ...


3

Take a look at X'[t]/Z'[t]: This is not the angle of rotation that you need. What you need is ArcTan[Z'[t],X'[t]], which looks like this If you change that in your code, you get the desired result.


3

Here is my modest attempt, based on a formula given in this math.SE answer, with a few affine transformations thrown in: triangle[pts_?MatrixQ, t_] := AffineTransform[{Transpose[{{2, -1, -1}/3, {0, 1, -1}/Sqrt[3]}.pts], Mean[pts]}][ Sec[t - π (2 Floor[3 t/(2 π)] + 1)/3] {Cos[t], Sin[t]}/2] pts = {{0, 0}, {1, 1}, {1, 3}/2}; mt[t_] = ...


0

You should check out the OutputType option, which allows you to specify Graphics output instead of the default Optical System output from functions like AnalyzeSystem, DrawSystem, and ShowSystem. mySystem = DrawSystem[{ConeOfRays[20, NumberOfRays -> 7], RefractiveIndex[1.5], Polarization[45], Ray[WaveLength -> .45, AddTo -> NewRay], ...


2

This seemed to get it to work: Animate[ParametricPlot[{{x[t], y[t]}} /. soln /. t -> a, {t, Max[0, a - 10000], a}, Prolog -> {Red, Disk[{0, 0}, r[2]]}, AxesLabel -> {x, y}, Axes -> False, ImageSize -> Large], {a, 0, tmax2}, AnimationRate -> 1000]


8

use ImagePadding as in f[x_, a_, b_] := a x - b x^3 Manipulate[ { Plot[f[x, a, b], {x, -2, 2}, ImagePadding -> 5], n = -Integrate[f[x, a, b] , x]; Plot[n, {x, -2, 2}, PlotRange -> Automatic, ImagePadding -> 5] }, {{a, 1/2, "control parameter"}, -1, 2, 0.1}, {{b, 1/4, "control parameter 2"}, -1, 2, 0.01} ]


1

You can try HighlightGraph with "DehighlightHide" highlight style. One thing I modify in PowerGraph is changing vertex {} to string vertex "{}". PowerGraph[l_] := Module[ {count = 1, treelist, vmaplist, t, label, ncolor}, treelist = Reap[ Fold[#1~Join~(#1 /. (x_ \[DirectedEdge] y_) :> (y \[DirectedEdge] (Sow[{count, #2}]; count++))) &, ...


3

This should get you started. But need to make some effort yourself to finish it. It is just Manipulate, using Graphics and Line and little kinematics. Manipulate[ tick; Module[{maxDistance = 100, maxTime = 10}, currentDistance += speed*delT; x = currentDistance Cos[slope Degree]; y = currentDistance Sin[slope Degree]; currentTime += delT; ...


3

Brief Update The point made in the comments is a good one, that you should never capitalize the first letter of variables, symbols, and function names in order to not conflict with built-in Mathematica names. I have changed the code below to reflect this (which I should have done from the beginning). Original Post First note that there are two errors in ...


5

Here's one without teeth, but it does have eyebrows, the eyes can change size, and the mouth smiles (or not): Manipulate[ eyeMat = {{1/(eyeRadius - pupilRadius/2), 0}, {0, 1/(0.15 + eyes - pupilRadius/2)}}; If[Norm[eyeMat.(pup - eyeCenter[[left]])] < 1, pupNow = pup - eyeCenter[[left]];]; If[Norm[eyeMat.(pup - eyeCenter[[right]])] < 1, ...



Top 50 recent answers are included