Hot answers tagged

29

A manual way of doing it is: Plot3D[With[{ϕ = ArcTan[x, y], r = Sqrt[x^2 + y^2]}, 0.3 Sin[2 π r + ϕ]] , {x, -5, 5}, {y, -5, 5} , BoxRatios -> Automatic, Mesh -> None, PlotPoints -> 25, MaxRecursion -> 4 ] The reasoning behind the code is as follows: We know we want to start with some ripples radiating outwards, something like $$\...


16

You may want to plot z(r, fi) = sin (r + fi) p = 20; Plot3D[ Evaluate @ Sin @ Tr @ CoordinateTransform["Cartesian" -> "Polar", {x, y}], {x, -p, p}, {y, -p, p}, PlotPoints -> 100, BoxRatios -> Automatic ] p = 30.; n = 9 10^4; pts = Catenate@Array[List, Sqrt[n] {1, 1}, {{-p, p}, {-p, p}}] + RandomReal[.2, n]; MapThread[ Append, {...


11

Here's my slight simplification of the Klein bottle parametric equations. I believe the original parametrization is due to Stewart Dickson (whose depiction of the bottle was in the "Graphics Gallery" of the old versions of The Mathematica Book). ParametricPlot3D[{6 Cos[u] (1 + Sin[u]), 16 Sin[u], 0} + 2 (2 - Cos[u]) {Cos[Clip[u, {0, π}]] ...


9

I'm not sure if I got the point, is this what you are after? gr2 = StreamPlot[{-1 - Sin[x]^2 + Sin[3 y] + Cos[y]^2, 1 + Sin[2 x] - Cos[y]^2}, {x, -Pi, Pi}, {y, -Pi/2, Pi/2}, AspectRatio -> 1/2, Frame -> False, StreamColorFunction -> "ThermometerColors", StreamPoints -> 250] GeoGraphics[ First @ gr2 /. Arrow -> (Arrow @ ...


8

Description For fun, thought I give it a try. Below is an example of my attempt to Plot Kleins bottle. Code klein[u_, v_] := Module[{ bx = 6 Cos[u] (1 + Sin[u]), by = 16 Sin[u], rad = 4 (1 - Cos[u]/2), X, Y, Z}, X = If[Pi < u <= 2 Pi, bx + rad Cos[v + Pi], bx + rad Cos[u] Cos[v]]; Y = If[Pi < u <= 2 Pi, by, by + rad Sin[u] Cos[...


7

This is just to give a solution based on minimal correction of the OP's code. a[u_] := 6 Cos[u] (1 + Sin[u]) b[u_] := 16 Sin[u] c[u_] := 4 (1 - Cos[u]/2) fx[u_, v_] := If[Pi < u <= 2 Pi, a[u] + c[u] Cos[v + Pi], a[u] + c[u] Cos[u] Cos[v]]; fy[u_, v_] := If[Pi < u < 2 Pi, b[u], b[u] + c [u] Sin[u]]; fz[u_, v_] := c[u] Sin[v]; ParametricPlot3D[{...


7

This is J.M.s answer. I post it as it nicely illustrates "flagging" countries and tooltips. Graphics[Select[Table[Tooltip[Inset[CountryData[i, "Flag"], {CountryData[i, "PovertyFraction"], CountryData[i, "CellularPhones"]/CountryData[i, "Population"]} // QuantityMagnitude, Automatic, Scaled[1/50]], CanonicalName[i]], {i, ...


7

Alternatively, you can use Needs["NDSolve`FEM`"] \[CapitalOmega] = ToElementMesh[ RegionDifference[Rectangle[{0, 0}, {100, 100}], Rectangle[{40, 40}, {60, 60}]], MaxCellMeasure -> {"Area" -> 1}] This will generate a second order mesh and you'll need far fewer elements to get an accurate solution then with a first order mesh (as ...


6

Here is code based on yours that I think produces the graph you want: listOfCountries = CountryData[#, "Name"] & /@ CountryData["Countries"]; povresults = Table[{i, CountryData[i, "PovertyFraction"], CountryData[i, "CellularPhones"]/ CountryData[i, "Population"]}, {i, listOfCountries}]; povresults = Select[povresults, FreeQ[#, Missing] &...


6

I personally would favour a RegionPlot Manipulate[RegionPlot[{0 < k1[s, d, m] <= 1, 0 < k2[s, d] <= 2, 2 < k3[s, d, m] <= 5}, {s, -1, 1}, {d, -1, 1}, PlotLabel -> m], {m, -5, -1}] If you want to use ListPlot col = {Red, Blue, Green}; mm = {-3.5, -2.5, -1.5}; Do[data[m] = {}; Do[If[0 < k1[s, d, m] <= 1 && 0 < k2[...


5

When you type in a notebook the expression Style[ Subsuperscript[Subscript["E", 0] [τ], m, a]/ Subsuperscript[Subscript["E", 0][N], m, m], FontSize -> 28 ] the output appears as This is StandardForm. When you use the same expression in a Plot3D the expression prints in TraditionalForm which typically is viewed as more appealing. If you ...


5

The result returned by WeatherData[] is a TimeSeries[] object. ListPlot[] can deal with it directly, but LinearModelFit[] needs some assistance to handle it, since it cannot directly deal with either TimeSeries[] or Quantity[] objects. Thus: trendLine = LinearModelFit[theTemps["Path"] // QuantityMagnitude, x, x] Show[ListPlot[theTemps, AxesLabel -> {"...


5

Here is another way that looks more like sand spirals with the tide coming in: With[{d = 42, n = 150}, ReliefPlot[ Cos@Table[ Through[(Abs + Arg)[x + I y]], {x, -d, d, d/n}, {y, -d, d, d/n}]]] As a side note, if you want to see a physics phenomenon where such Archimedean spirals occur, you may find this link to my web page interesting.


5

Example Code NumberLinePlot[(Interval @ # & /@ Transpose[{b, a}]), PlotLegends -> "Expressions"] Output Reference Interval Transpose NumberLinePlot


5

You can supply any Graphics primitives directly to the Plot using Epilog Plot[f[x], {x, -2.5, 10}, Epilog -> {Blue, Thick, Dashed, Line[{{{1, 0}, {1, f[1]}}, {{0, f[1]}, {1, f[1]}}}]}] For your plot you can also put those point labels in using the Text graphics primitive, like Epilog -> {Text[Style["1/e", 13], {-.4, f[1]}], Blue, Thick, ...


4

Any wave form could be used: ParametricPlot3D[{r Cos[t], r Sin[t], 0.2 TriangleWave[r - t/(2 Pi)]}, {r, 0, 6}, {t, 0, 2 Pi}, Mesh -> None, PlotPoints -> {121, 30}] ParametricPlot3D[{r Cos[t], r Sin[t], Sin[r - t]}, {r, 0, 60}, {t, 0, 2 Pi}, Mesh -> None, PlotPoints -> {121, 30}] Etc.


4

Thies's solution is excellent. This was the best I could do with a logarithmic spiral: With[{ψ = 87°}, Plot3D[Tanh[(x Sin[Tan[ψ] Log[x^2 + y^2]/2] + y Cos[Tan[ψ] Log[x^2 + y^2]/2])/10], {x, -20, 20}, {y, -20, 20}, Axes -> None, BoundaryStyle -> None, Boxed -> False, BoxRatios -> Automatic, ColorFunction ...


4

Generating the outline By looking at the code we can infer that the position of the center of the outermost circle is given by outline[a_, t_] := Module[{ A = Accumulate[a Table[Cos[2 Pi i t], {i, Length[a]}]], B = Accumulate[a Table[Sin[2 Pi i t], {i, Length[a]}]] }, {Last[A], Last[B]}] This code comes straight from the one you posted; each ...


4

You can get both as one Historam with custom right FrameTicks: ticks = Join[ Transpose[{#, ConstantArray[Null, Length@#]}] &@Range[0, 42, 2], {#, N@#/Length@Tabla} & /@ Range[0, 40, 10]] /. (0.) -> 0 Histogram[Tabla, Frame -> {{True, True}, {True, False}}, FrameLabel -> {{"frequência", "frequência relativa"}, {"tempo (s)", None}}, ...


4

In addition to NumberLinePlot -- which is a version 10 function -- one can customize a Graphics function. plot[ from_List, to_List, opts___] /; Length[b] == Length[a] := Module[{z = 0, lines}, lines = Apply[ Module[{ends}, ends = {{#1, z}, {#2, z}}; z++; {Gray, Dashed, Thin, Line[{{#[[1]], 0}, #}] & /@ ends, ...


4

Okay, so you have a set of Regions that you want to fill, but you can only define those regions by a set of points distributed within them. Let's make some data that reproduces this. Here are three non-overlapping regions that fill up a square: region1 = Disk[{0, 0}, 1, {0, π/2}]; region2 = RegionDifference[Rectangle[], region1]; region3 = Disk[{0, 0}, 1, ...


4

One can use the new function DistanceMatrix[] for the purpose; this avoids repeated computations (since the underlying matrix is symmetric). With[{stepSize = 2, end = TMax}, MatrixPlot[UnitStep[0.01 - DistanceMatrix[uSolpbc[Range[0, end, stepSize], 0]]]]] and your plot is produced very quickly, without the need to invoke parallelization.


4

For the fun of reproducing the original picture somewhat faithfully (yes, I can't seem to focus on real work this morning...): f[x_] := x/E^x; Plot[ f[x], {x, -2.5, 10}, Ticks -> { {0, 1}, {{1/E, Row[{Style["1/", FontFamily -> "Times"], Style["e", FontFamily -> "Times", Italic]}]}} }, TicksStyle -> Directive[Black, 12], PlotRange ->...


4

There are a number of ways of doing this by combining 2 curves. For example Plot[{If[x < 1, x^2], If[x > 1, x^2 - 1]}, {x, 0, 2}, PlotStyle -> {Red, Blue}] I don't know if there is a way where the colour information can be tagged to the values themselves.


4

One possibility : Plot[ If[x < 1, x^2, x^2 - 1], {x, 0, 2}, Mesh -> {{1.001}}, MeshFunctions -> {#1 &}, MeshShading -> {Blue, Red} ]


4

Well, maybe you can make something with this? a1 := SliceContourPlot3D[z, x == 0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}, Background -> Black, ContourShading -> White, Contours -> 9, TicksStyle -> {Red, Green, Blue}] a2 := SliceContourPlot3D[z, y == 0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}, ContourShading -> White, Contours -> 9] ...


4

Tricks to my mind,Suppose your version is 10.2 or later,although I don't sure you will like Show[SliceContourPlot3D[#, "CenterPlanes", {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, ContourShading -> White] & /@ {x, y, z}, Axes -> True, Boxed -> False, AxesOrigin -> {0, 0, 0}]


3

You have many superfluous sets of {} that generate unexpected output in your code. In particular, the Interpolation functions generated by NDSolve were not returning a scalar value, but instead a unidimensional vector, i.e. a list containing a single value instead. That was probably an unintended consequence of the extra sets of braces in the definitions of ...


3

Clear["Global`*"] yy = 10^-4; rr = 0.999; xx = 10^-15; zz = 10^-4; mm = 10^-4; yy + rr + xx^2 + zz - mm^2 - zz^2/24 ic = -17.5 s = NDSolve[{D[y[t], t] == (3 y[t])/5 - (12 m[t]^2 y[t])/5 + (2 r[t] y[t])/ 5 - (6 x[t]^2 y[t])/5 + (3 y[t]^2)/5 + (7 y[t] z[t])/ 5 - (y[t] z[t]^2)/10, D[r[t], t] == -((2 r[t])/5) - (12 m[t]^2 r[t])/5 + (2 r[...


3

Just in case anyone comes across this post in a search, here is a one-liner here for version 10 and after. If latlong is the list from the OP, then you can do this GeoGraphics[{Red, PointSize[.02], Point@GeoPosition@latlong}] The input for GeoGraphics is structured like that for Graphics, and you can use a whole host of options GeoGraphics[{Red, ...



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