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

region = ImplicitRegion[ 0 < z < 4 - x*y && 0 <= x <= 2 && 0 <= y <= 1, {x, y, z}]; RegionPlot3D[region, BoxRatios -> {1, 1, 1}, Axes -> True] Volume[region] (* 7 *) RegionMeasure[region] (* 7 *) Integrate[1, {x, 0, 2}, {y, 0, 1}, {z, 0, 4 - x*y}] (* 7 *) Integrate[1, Element[{x, y, z}, region]]...


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, π}]] ...


10

You can use RegionFunction to set the region: Plot3D[Log[Cos[x]/Cos[y]], {x, -(π/2), 3 π/2}, {y, -(π/2),3 π/2}, RegionFunction -> Function[{x, y, z}, -(π/2) < x < π/2 && -(π/2) < y < π/2 || π/ 2 < x < (3 π)/2 && π/2 < y < (3 π)/2]] Or you can construct the region and plot inside it: reg = ...


9

First use Tally to count the number and then use BubbleChart. data1 = Tally[data] /. {{x_, y_}, z_} :> {x, y, z} BubbleChart[data1]


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

We can use symmetry and find such points that have the same $x$ coordinate and difference of their $y$ coordinates is twice the $x$ coordinate. We use FindRoot and help it with initial point which we choose as the maximum $x$ coordinate - maxXt. Then we need to mirror two points and draw lines between. r[t_] := 2 - 2 Sin[t] + Sin[t] Sqrt[Abs[Cos[t]]]/(Sin[t]...


8

Not sure how useful will this be. Usually Standardize-d data is giving better results. We can also cut off parts of the surface which are distant from our data. rf = Nearest[Standardize@data] sr = ListSurfacePlot3D[Standardize @ data, BoxRatios -> 1, MaxPlotPoints -> 100, RegionFunction -> Function[{x, y, z}, Norm[{x, y, z} - rf[{x, ...


8

I think this is what you're looking for: dostot = Union[dos1, dos2][[All, 3]]; {emin, emax} = MinMax[dostot]; de = .25; Histogram[dostot, {emin, emax, de}, "ProbabilityDensity"] The definition of dostot differs from yours in that I discard all the coordinate values that would only be needed to make 3D plots. The relevant energy is stored as the third ...


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

The problem appears only when you use some specific stylesheets of the notebook. To replicate the issue one can choose standard report from Format->Stylesheets->Report. To get rid of the issue you can either use some stylesheet without a background for labels or remove the backgroud by manually changing BaseStyle -> {FontSize -> 17, Background -> ...


7

I am assuming that this not just (#2&) as the color function. Here are various ways: f[x_, y_] := Cos[x + I y]; g[x_, y_] := Re@f[x, y]; h[x_, y_] := Im@f[x, y]; scp = SliceContourPlot3D[ h[x, y] - z, {z == g[x, y], z == -2}, {x, -2 Pi, 2 Pi}, {y, -2, 2}, {z, -2, 2}, Contours -> 10, ColorFunction -> "Rainbow", BoxRatios -> ...


7

Update Using @kglr suggestions to overcome Histogram3D's ColorFunction limitation. Histogram3D[ Flatten[MapIndexed[ConstantArray[#2, #1] &, #, {2}], 2] & /@ {terrain, water}, Automatic, "Count", ChartLayout -> "Stacked", ChartStyle -> {Opacity[1], Blue}, ChartElementFunction -> {ChartElementDataFunction[ "GradientScaleCube", "...


7

Needs["NDSolve`FEM`"] mesh = ToElementMesh[Disk[]]; ufun = NDSolveValue[ {-Laplacian[u[x, y], {x, y}] == 1, DirichletCondition[u[x, y] == 0, True]}, u, {x, y} ∈ mesh]; Plot3D[ufun[x, y], {x, y} ∈ mesh, Mesh -> All] Two things to note: Plot3D directly takes an ElementMesh giving the option Mesh->All uses that specific mesh in the ...


7

There is a good demonstration of how ExclusionsStyle works here. Check Plot[Floor[x], {x, 0, 5}, ExclusionsStyle -> {Red, Blue}] If you use the second form of ExclusionsStyle, you will see the points (boundary of exclusion region) that are being connected by your asymptote: Plot[1/(x - 1)^3, {x, -5, 5}, PlotRange -> {{-5, 5}, {-5, 25}}, PlotStyle -...


7

You can use MeshFunctions to visualize the intersection. The following is one way to parametrize curve. f[x_, y_] := 2 x^3 - 5 y^4; p[x_, y_] := x + y + 5; expr = x /. Quiet[First@Solve[f[x, y] == p[x, y], {x, y}, Reals]]; t[u_] := expr /. y -> u; par[w_] := {t[w], w, p[t[w], w]}; p3D = Plot3D[{f[x, y], p[x, y]}, {x, -20, 20}, {y, -10, 10}, ...


7

This looks like a bug. Please report it to Wolfram Support. A simple workaround is to specify your own colour function. ArrayPlot[{{1, 0.1, 0}, {0.1, 0, 0}}, PlotLegends -> Automatic, ColorFunction -> (GrayLevel[1 - #] &)]


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

As a quick answer based upon TemporalData and the use of MovingMap: x = Get@"http://pastebin.com/raw/7xwgGDsd"; time = Table[t/60, { t, 1, Length @ x }] // N; (* seconds *) (* make these data TemporalData *) td = TemporalData[Transpose[{time, #}] & /@ Transpose[x]]; $PlotTheme = "Scientific"; Show[ { ListLinePlot @ td, ListLinePlot[ ...


6

Can NIntegrate remember or make full use of the result of a smaller upper-limit integral? Or generally, how to speed up the plot involving NIntegrate or is there any principle to do it? Below is a solution in the spirit of this request. In short, we find adaptively sampled points, compute integral estimates over the intervals having those points as ...


6

A series of n cosine functions at successively doubled frequencies can be phased so their signs produce a Gray Code (– for 0, + for 1). If these cosines are also scaled to successively halved amplitudes, they partition the plane over one major cycle into 2^n non-overlapping regions, just like the circles of a Venn diagram. These regions cover the angle axis ...


6

lst = Table[{Sin[n], Sin[2 n]}, {n, 50}]; opacities = RandomReal[1, {50}]; ListPlot[List /@ lst, PlotStyle -> (Opacity /@ opacities), BaseStyle -> PointSize[Large]]


6

data = Table[ PDF[BinomialDistribution[50, p], k], {p, {0.3, 0.5, 0.8}}]; DiscretePlot[ Evaluate@data, {k, 1, 50}, PlotStyle -> { Directive[Black, Opacity[.5], AbsoluteDashing[{5, 5}]], Directive[Black, Opacity[.5], AbsoluteDashing[{10, 10}]], Directive[Black, Opacity[.5], AbsoluteDashing[{0, 0}]]}, PlotMarkers -> {Automatic,...


6

This is not answer, but an extended comment that displays a graphic. The code you post in your question does not work in any recent version of Mathematica. It is syntactically and semantically incorrect. The following modified code does work. My question is: does it produce the plot you want to translate into LaTeX? rose[x_, theta_] := Module[ {...


6

I think your best bet is to generate a triangualted polygon surface. Here is an initial stab at it: p2d = b[[All, 1 ;; 2]]; tri1[i_, j_] := If[EvenQ[j], {{i, j}, {i + 1, j}, {i + 1/2, j + 1}} .05, {{i + 1/2, j}, {i + 1 + 1/2, j}, {i + 1, j + 1}} .05] tri2[i_, j_] := If[EvenQ[j], {{i, j}, {i + 1, j}, {i + 1/2, j - 1}} .05, {{i + 1/2, j}, {i + ...


6

You could plot each data point with a marker that is also its label. Like so labels = CharacterRange["A", "Z"]; SeedRandom[42]; data = List /@ Transpose[Table[RandomSample[Range[26]], 2]] ListPlot[data, PlotStyle -> Black, PlotMarkers -> labels] Note Each data point must be wrapped in a list. That is, {{{14, 3}}, {{21, 25}}, ..., {{26, 12}}, {{...


6

colors = ColorData[1, "ColorList"][[;; Length@data]]; Deploy@DynamicModule[{pt = ({##2} & @@@ data), pt2 =(4 {##2} & @@@ data), lbls = Module[{i = 1}, Framed["Label" <> ToString[#], FrameStyle -> colors[[i++]]] & @@@ data]}, ListPlot[List /@ pt, PlotStyle -> PointSize[Large], PlotRange -> 50 {{-1, 1}, {...



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