Tag Info

New answers tagged

1

You can animate the function being drawn by varying the range of t, not t itself (since t is already fixed). However, you'll need to fix PlotRange (and probably PlotPoints) for animation to look nice: Animate[ ParametricPlot[ {xC[t], yC[t]}, {t, 0, u}, PlotRange -> {{-1.5, 3.5}, {-1, 4.5}}, PlotPoints -> 60 ], {u, 0.01, 2} ] ...


9

It really helps others reading your code if you split things up and name parts of the code. Let's start with the polynomial. polynomial[k_] := Total[x^Range[0, 20, 3]] + k x^3; and the function that finds the roots, and the function that visualizes them roots[poly_, x_] := roots[poly, x] = Through@*{Re, Im} /@ (x /. NSolve[poly, x]) frame[k_, opacity_] ...


2

data := RandomVariate[WignerSemicircleDistribution[1, 3], 10^4]; Dynamic[Clock[{0, 5, 1}, 1]; Histogram[data, 20, "PDF", ChartStyle -> EdgeForm[White], Axes -> False, PlotRange -> {{-4, 6}, {0, .25}}, ImageSize -> 400, Frame -> True, Epilog->First[Plot[PDF[WignerSemicircleDistribution[1, 3], x], {x, -4, 6}, PlotStyle->Thick]]]]


4

Kuba answered this question in a comment, but I think it needs to be recorded as a formal answer. You can animate your static plot by wrapping it with Dynamic and supplying the option UpdateInterval. data := RandomVariate[WignerSemicircleDistribution[1, 3], 10^4]; Dynamic[ Show[ Histogram[data, 20, "PDF"], ...


3

Use the fourth parameter of Inset: f = Sin[#] + 5 &; image = ExampleData[{"TestImage", "Lena"}]; Animate[Plot[{f[z]}, {z, 0, 50}, PlotRange -> {{0, 50}, {0, 10}}, Epilog -> Inset[image, {x, f[x]}, Automatic, 10]], {x, 0, 30}]


13

Usually viruses have icosahedron symmetry. So I propose to generate a random chain of balls and translate it appropriately n = 2000; f = GaussianFilter[#, 5] &; p = f@RandomReal[{3.0, 4.0}, n] #/Sqrt@Total[#^2, {2}] &@ Accumulate@Prepend[0.08 f@RandomReal[NormalDistribution[], {n - 1, 3}], Normalize@RandomReal[NormalDistribution[], 3]]; r = ...


6

The Interpolation approach: data = Flatten[{{{#1, 2 #2}, 1} & @@@ RandomReal[{0, Pi}, {2000, 2}], {{#1, 2 #2}, 1 + RandomReal[]/3} & @@@ RandomReal[{0, Pi}, {100, 2}]}, 1]; dataf = Interpolation[data, InterpolationOrder -> 1]; SphericalPlot3D[dataf[θ, ϕ], {θ, 0, Pi}, {ϕ, 0, 2 Pi}, PlotStyle -> Directive[Orange, Opacity[0.7], ...


6

This might qualify, too: Graphics3D[{Orange, First@PolyhedronData["MathematicaPolyhedron"]}, Boxed -> False, Lighting -> "Neutral", Background -> Black]


13

Simple solution with numerous spheres: n = 10000; r1 = RandomReal[{2, 2.1}, n]; r2 = RandomReal[{0.1, 0.12}, n]; aa = RandomReal[{-(Pi/2), Pi/2}, n]; bb = RandomReal[{0, 2 2Pi}, n]; s[p_, r_] := {Hue[10 r], Sphere[p, r]}; p[r_, a_, b] := r {Cos[a] Sin[b], Cos[a] Cos[b], Sin[a]}; Graphics3D[{Specularity[White, 30], MapThread[s, {MapThread[p, {r1, aa, bb}], ...


3

It's difficult to help you out without having definitions for your various graphs. If I understand your question, you want to pause an Animator at a particular spot. Here's a proof of concept example: DynamicModule[{i, t}, Column@{Animator[Dynamic[i], {0, 10}, AnimationTimeIndex -> Dynamic[t]], Dynamic@Plot[Sin[x + i], {x, 0, 10}], ...


15

Found this somewhere: ϕ = GoldenRatio; s = 1.75; ContourPlot3D[ -(4*(ϕ^2*x^2 - y^2)*(ϕ^2*y^2 - z^2)*(ϕ^2*z^2 - x^2) - (1 + 2 ϕ)*(x^2 + y^2 + z^2 - 1)^2) == 1.1, {x, -s, s}, {y, -s, s}, {z, -s, s}, ContourStyle -> White, Boxed -> False, Axes -> False, SphericalRegion -> True, Mesh -> 5, BoundaryStyle -> None, PlotPoints -> 45, ...


2

pl = Table[ Plot3D[fun[t, x, y], {x, -5, 5}, {y, -5, 5}, PlotRange -> All, PlotLabel -> Style["Time = " <> ToString[t], Bold]], {t, 0, 4, 1}]; Export["time.gif", pl, "DisplayDurations" -> 1]


3

Just another approach. Not ideal but may be motivating: f[t_] := With[{c = Cos[t], s = Sin[t]}, Graphics[{Circle[], {Green, Line[{{0, 0}, {c, 0}}]}, {Red, Line[{{c, 0}, {c, s}}]}, {Black, Line[{{0, 0}, {c, s}}]}, {Text[ Style[NumberForm[180 t/Pi, 3], White], 0.1 {Cos[t/2], Sin[t/2]}, Background -> Orange]}, {Text[ ...


3

As Sjoerd points out, a good place to start is by recognising that the line from the ant to the tip of the grass must be a tangent to the curve. So you can solve for the x positions of the ant where this is true: antx = x /. NSolve[(8 - f[x])/(32 - x) == f'[x], x, Reals] (* {14.9475, 8.62026} *) Here's a plot showing those points and the line-of-sight to ...


2

Like this? Animate[ParametricPlot[{{Cos[2 Pi t], Sin[2 Pi t]}, {t Cos[2 Pi s], t Sin[2 Pi s]}, {t Cos[2 Pi s], 0}, {Cos[2 Pi s], t Sin[2 Pi s]}, {.1 Cos[2 Pi s t], .1 Sin[2 Pi s t]}}, {t, 0, 1}, PlotStyle -> {{Thick, Blue}, {Thick, Black}, {Thick, Green}, {Thick, Red}, {Thick, Orange}}, PlotRange -> {{-1.3, 1.3}, {-1.3, 1.3}}, ...


0

DynamicModule[{pt = {0, 0}}, ClickPane[ Graphics[{Orange, Dynamic@Disk[pt]}, PlotRange -> 5, Frame -> True], With[{w = MousePosition["Graphics"] - pt}, Do[pt += w/4.; Pause[.1]; FinishDynamic[]; Print[pt], {4}]] &] ] At the end you can use Eventhandler but for testing ClickPane is quite handy here. Feel free to ask if anything is not ...


4

This may help Hillheight[x_] := (1/16 x^2 - 2 x + 80)/(1/16 x^2 - 2 x + 20)^2 Hill = Plot[(1/16 x^2 - 2 x + 80)/(1/16 x^2 - 2 x + 20)^2, {x, 0, 32},PlotRange -> {0, 8}]; BladeofGrass = ParametricPlot[{32, 1/5 + x}, {x, 0, 39/5}, PlotStyle -> {Green}]; line[xANT_, x_] := InterpolatingPolynomial[{{xANT, Hillheight[xANT]}, {32, 8}}, x]; ...


2

Not sure I understood it properly. Instead of Animate, looking at slope variations plots may also help determine points near tangency. f[x_]=(1/16 x^2-2 x+80)/(1/16 x^2-2 x+20)^2; Hillheight[x_]:=(1/16 x^2-2 x+80)/(1/16 x^2-2 x+20)^2; Hill=Plot[Hillheight[x],{x,0,32}] BladeofGrass=ParametricPlot[{m/5+x, m x },{x,0,35},{m,.05,0.5},PlotStyle->{Green}]; ...



Top 50 recent answers are included