Hot answers tagged

51

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} ]


40

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


31

I feel that once you start with Moire patterns, there's no ending. The way I would replicate these is by making a grid into a function (like @JasonB) but also parametrise the angle of rotation into it: lines[t_, n_] := Line /@ ({RotationMatrix[t].# & /@ {{-1, #}, {1, #}}, RotationMatrix[t].# & /@ {{#, -1}, {#, 1}}} & /@ ...


23

What you need to do here is to generate a ParametricPlot to give the 2D goat/silo problem, and then we can rotate it with RevolutionPlot3D. From reading the page on MathWorld, we can see that we need to make a circle involute to describe the portion of the area where the goat's circle is limited by the presence of the silo. In Cartesian coordinates, this ...


23

Something like this: nlines = 30; Table[ Overlay[ Rotate[ Graphics[{ Table[{ Line[{{0, n}, {nlines, n}}], Line[{{n, 0}, {n, nlines}}]}, {n, 0, nlines}], Text[Style[#1, 18], {0, 0}, {-1, -1}, Background -> White] }, AspectRatio -> 1, PlotRangePadding -> None, ImageSize -> ...


12

Yes, you can plot it, but not using Plot. For example, you could map the function over a range of values and then use ListLinePlot: With[{xmin = 0, xmax = 4π}, ListLinePlot[f/@Subdivide[##,100],DataRange->{##}]&[xmin,xmax] ] This uses the new function Subdivide with 100 plot points. The reason why Plot requires you to specify a dummy variable is ...


12

I like to keep things simple, so I'll skip the letter labels, but include the lines overhanging from the grid: m = 30 (* number of mesh lines *); h = 2 (* overhang *); lins = Join[#, Map[Reverse, #, {2}]] & @ Outer[{##} &, ArrayPad[Range[-1, 1, 2/m], h, "Extrapolated"], {-1, 1}]; Table[Graphics[{AbsoluteThickness[1/100], ...


11

The advice below is for 10.4 and above. It appears there is a bug in 10.3 and lower. On the surface, it looks like a bug. But, it is a bug in ticksfun. To see why, we need to see what is being passed into it, so we modify it as follows: minmax = {}; ticksfun[xmin_, xmax_] := (minmax = {xmin, xmax}; Table[{10^i, Superscript[10, i]}, {i, ...


11

The most convenient way is to start from the parametric equations of the lemniscate of Bernoulli, instead of insisting on the implicit equation. I can't be bothered to remember the precise parametric equations, but I do remember that the lemniscate is the inverse curve of an equilateral hyperbola. Thus, lem[t_] = TrigExpand[Sqrt[2] #/(#.#) &[{Sec[t], ...


10

Here is one way: noIn[y_, x_] = y; noIn[Indeterminate, x_] = Round[x]; transIn[x_] = noIn[(1 + Erf[2 ArcTanh[2 x - 1]])/2, x]; transOut[x_] = noIn[(1 - Erf[2 ArcTanh[2 x - 1]])/2, x]; SeedRandom[15] f[x_, y_] = RandomReal[{-1, 1}, 4].Sin[RandomReal[{-2, 2}, {4, 4}].{1, x, y, x^(4/3)}]/3; r[t_] = {1/2 + Sin[t] + t^(3/2) - (t/2)^2, Sin[t] - t^2 + (2 t/3)^5 - ...


10

How about discretizing the letter's boundary? stringBoundary[char_String] := RegionBoundary[DiscretizeGraphics[First@ImportString[ExportString[char, "PDF"]]]] stringBoundary["D"]


9

ok, this is cheating but since your gas is non-interacting it works. 3 dimensions or 1 dimensions is the same since the collisions only change momentum in the normal direction, ie we assume point particles and no friction. A collision with a wall the only thing it does is to invert the velocity. So you can think of the particle moving at a constant speed ...


9

You can use FoldList to generate evolution of your system. You need a function that propagates your particles in time. Every time you apply your function to state at time $t$ you obtain your state at time $t+dt$. Let's make such function for one particle in 1D. Tr1D[{x_, v_}, dt_, L_] := Module[{u, w}, u = x + v dt; {u, w} = If[u < L, {u, v}, {L - ...


9

As noted by kirma, this function is highly oscillatory. However, from its form it is periodic in t with period 2 Pi and has its maximum near Pi/4 except for small kl. For instance, Plot[Evaluate[Cos[t] Sinc[2 Pi kl (Sin[t] - 1/Sqrt[2])] /. kl -> Range[0, 2, 1/2]], {t, 0, 2 Pi}, PlotRange -> All] Because ArgMax sometimes finds a local ...


9

This is very similar to Quantum_Oli's answer, but I will post it anyway. It use's a modified version of Jens's plotGrid function to do the work of combining the plots. The function is imported from a pastebin to save space here, << "http://pastebin.com/raw/tmMYLyMh"; hist = Show[ Plot[140 PDF[SmoothKernelDistribution[#], x] & /@ {data1, ...


8

You can use ContourShading with Directives to achieve both. α = 1; β = 1; tmp = 0.1316; ρ = 0.01; t = -1.5; fe[m_, p_] := 1/2*(t - 1)*p^2 + 1/4*p^4 + (1/2*α^2*β*m^2*(t - tmp)) + 1/4 α^2*(β)*(m^4) + 1/2*(ρ*(p^2)*(m^2)) ; SliceContourPlot3D[-z, z == fe[m, p], {m, -3, 3}, {p, -3, 3}, {z, -6, 6}, ContourShading -> Directive[Red, ...


8

You can add transparency to a color function. No need to make the whole plot to have one color. Show[SliceContourPlot3D[-z, z == fe[m, p], {m, -3, 3}, {p, -3, 3}, {z, -6, 6}, ColorFunction -> Function[{z}, Opacity[0.4, #] &@ColorData["TemperatureMap"][z]], ContourStyle -> None]]


8

You can plot the surface and the vector fields separately and then combine them together. Here is an example. Consider the spherical radius r can be written as function $r(\theta,\phi)$: mysurface[θ_, ϕ_] = FullSimplify[Re[SphericalHarmonicY[3, 2, θ, ϕ]], Assumptions -> {θ ∈ Reals, ϕ ∈ Reals}] (* 1/4 Sqrt[105/(2 π)] Cos[θ] Cos[2 ϕ] Sin[θ]^2 *) ...


8

Histogram does not support a grouped ChartLayout. Hence the workaround using BarChart: I've arranged the 'histogram' into a bar chart so that the data can be displayed side by side. An alternative to using BarChart with "Grouped" layout is to use a custom ChartElementFunction to produce the desired Histogram layout: ClearAll[groupedHistogram] ...


7

So the idea here is to generate a plot, use the Filling->Axis option, then extract the polygons from that. Options[fencePlot] = {"YValues" -> Automatic, "Colors" -> Automatic}; fencePlot[funcs_, {x_, xmin_, xmax_}, opts : OptionsPattern[{fencePlot, Graphics3D}]] := Module[{yv, pgons, colors}, yv = OptionValue["YValues"] /. Automatic ...


7

I think it may perhaps be easier just to combine plots and modify (e.g. suppress unnecessary frame ticks). I post this as a motivating answer rather than definitive answer. li is a modified version of OP function: li[p_, q_, phi_, {l_, u_}] := DensityPlot[(If[p > 0, Sin[2 Pi p^2 x]/(2 Pi p^2 x), 1] Cos[ 2 Pi p^2 q x + phi/2])^2, {x, -30, 30}, {y, ...


7

$d(x,y)$ is the distance between two points. $d(x,y)=|x-y|$ means the length of vector $x-y$. This vector can be in $n$-dimensional space. Your metrics in Mathematica would be d[x_List, y_List] := Norm[x - y]. Suppose you have $x_0$ and you want find all points $y$ in 2D such that $d(x_0,y)<r$. Now $y=(y_1,y_2)$ is a point in 2D, it's not the second ...


7

From Version 10.2 upwards we can now use SliceContourPlot3D and SliceDensityPlot3D to achieve this: SliceContourPlot3D[x + Sin[5 z] + y^2, "CenterCutBox", {x, -0.5, 0.5}, {y, -0.5, 0.5}, {z, -0.5, 0.5}, Boxed -> False, Axes -> False, Contours -> 20, ColorFunction -> Hue] You can increase Contours to 10 or higher to ...


7

You can always impose this constraint with the option RegionFunction: PolarPlot[Sin[θ] Cos[θ], {θ, 0, 2π}] PolarPlot[Sin[θ] Cos[θ], {θ, 0, 2π}, RegionFunction -> Function[{x, y, θ, r}, r > 0]]


7

You can do something like this, SetAttributes[verbosePlot, HoldAll] verbosePlot[plotcommand_] := Module[{plot, pp, mr}, {pp, mr} = {PlotPoints, MaxRecursion} /. (Trace[plot = plotcommand, HoldPattern[(MaxRecursion -> _Integer) | (PlotPoints -> _Integer)], TraceInternal -> True] // Flatten // Reverse // ...


7

It is indeed possible, although not necessarily straightforward. The method I present below gives a pretty robust and accurate way of lining up plots, the downside is a little bit of code and having to specify a few different options. I'm used to it, it works. The key is that by specifying the ImageSize, and the Left and Right components of the ImagePadding ...


7

The following is a universal solution which extracts RGB color values assigned to the Line primitives of a plot generated by built-in plotting functions of Mathematica 10: Cases[fplot, {___, c_Directive, __Line} :> ColorConvert[c, RGBColor], Infinity] // InputForm {RGBColor[0.368417, 0.506779, 0.709798, 1.], RGBColor[0.880722, 0.611041, 0.142051, ...


7

Rather than Show, you can use Prolog + Inset with Scaled: Plot[ 140 PDF[SmoothKernelDistribution[#], x] & /@ {S086, T086, X086}, {x, 0, 100}, Evaluated -> True, PlotStyle -> { {Thickness[0.01], RGBColor[0.23, 0.42, 0.63]}, {Thickness[0.01], RGBColor[0.29, 0.53, 0.80]}, {Thickness[0.01], RGBColor[0.62, 0.73, 0.88]}}, Frame -> ...


6

To see what is happening here, first plot a blow-up of the 2D region to show clearly the contours. ListContourPlot[locus[0.1], Contours -> {0.1}, InterpolationOrder -> 1, ContourShading -> None, PlotRange -> {{-0.2, 0.6}, {-0.4, 0.4}}] The plot appears to consist of four ellipses plus two ragged curves. Note that InterpolationOrder ...


6

LogLogPlot plots contain a dynamic objects which when you open the notebook, the security of Mathematica prevents the dynamic objects from being updated. Check this What you can do is wrap your plot with dynamic and when opened again and when you click Enable Dynamic, you will get the correct plot. Dynamic@Labeled[LogLogPlot[x, {x, 10^-5, 1}], "Test"]



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