New answers tagged

0

Example Description This can be achieved using PlotRange -> {{xmin,xmax},{ymin,ymax},{zmin,zmax}}, you can use Automatic as an argument to let Mathematica decide what is min or max. For example, PlotRange -> {Automatic, Automatic , {1,Automatic}} Code m = 1; q = 5/2; K = Sqrt[4 m/(3 - q)]; \[Xi] = (q - 1)^2/4 K^2; A = Pi/Sqrt[\[Xi]]; Plot3D[ 1/A (...


1

Transforming ternary data (x1,x2,x3) to carthesian (x,y) Wikipedia gives a nice formula for transforming ternary data to cartesian data here(cf. "Plotting a Ternary plot"). This can be used to build a transformation matrix: tm1 = { {0, 2, 1, 0}, {0, 0, Sqrt[3], 0}, {0, 0, 0, 0}, {0, 0, 0, 1} }; (* ...


2

Here is the equivalent of your 1-d approach, using @ ce's henon henon[alpha_, beta_][{x_, y_}] := {y + 1 - alpha x^2, beta x} Manipulate[ list = NestWhileList[henon[a, b], {1, 1}, Max[Abs[#]] < 200 &, 1, 2000]; ListPlot[list[[-Min[20, Length@list] ;;]], PlotRange -> All], {{a, -.3}, -1, 1}, {{b, -.4}, -1, 1}] the trick here is to use ...


5

Show applies any graphics option given to it to all the graphics given to it as arguments. But Joined -> True is not a graphics option, but a special option of certain types of plots; therefore, Show ignores it. Here are two work-arounds. SetOptions[ListPlot, Joined -> True]; Show[ListPlot[Range[10]], ListPlot[Range[10] - 1]] SetOptions[ListPlot, ...


2

First define the map: henon[alpha_, beta_][{x_, y_}] := {y + 1 - alpha x^2, beta x} And then you can do something like list = NestList[henon[1.4, 0.3], {1, 1}, 10000]; ListPlot[list] It is straightforward to wrap this in Manipulate.


1

I guess you could just do the minimization numerically. f[a_, alpha_, b_, beta_, tau_, t1_, t2_] := (2 (3 a^2 + 3 a alpha t1 + alpha^2 t1^2))/t1^3 + (2 (3 b^2 - 3 b beta t2 + beta^2 t2^2))/t2^3 - (1 - t1 - t2) tau fmin[a_, alpha_, b_, beta_, tau_] := NMinValue[{f[a, alpha, b, beta, tau, t1, t2], t1 >= 0 && t2 >= 0 && t1 + ...


2

The problem is plot quality, not the code. The answer is MaxRecursion ParametricPlot3D[{I01[x, y], I11[x, y], I02[x, y]}, {x, 0, 8 \[Pi]}, {y, 0, 8 \[Pi]}, MaxRecursion -> 5]


1

With your definitions, use: integral[v_?NumericQ, x_?NumericQ] := (1/d[v, x])*Exp[NIntegrate[2 q[s, x]/d[s, x], {s, 0, v}]] Plot3D[ integral[v, x], {v, -0.5, 0.5}, {x, -0.1, 0.1}, PlotPoints -> 10, MaxRecursion -> 0 ] Read this FAQ to see why you need to use NumericQ in this case. Having said that, your function assumes insanely high ...


3

Show[Plot3D[x y, {x, -10, 10}, {y, -10, 10}, BoundaryStyle -> Red, MeshStyle -> Red, PlotStyle -> None, Mesh -> 8, AxesLabel -> {x, y}], ListPointPlot3D[ Table[{x, y, x y}, {x, -10, 10, 2 + 2/9}, {y, -10, 10, 2 + 2/9}], PlotStyle -> {{Red, PointSize[0.015]}}], AspectRatio -> 1]


1

How about this? ListPlot3D[Table[x y, {x,0, 10}, {y,0, 10}], Mesh -> 10, MeshStyle -> Red, MeshShading -> {{None, None}, {None, None}}, BoxRatios -> 1, Boxed -> False, BoundaryStyle -> Red, AxesLabel -> {"x", "y", "z"}] Or with Plot3D Plot3D[x y, {x, 0, 10}, {y, 0, 10}, Mesh -> 10, MeshStyle -> Red, MeshShading -> {{...


2

Use Show instead of Epilog to add on the rectangles, and the legend will stay on top. Show[ ListDensityPlot[..., PlotLegends -> ...] Graphics[{...}] ]


2

This is just illustrative. f[z_] := ReIm[z + 1/z] Manipulate[ ParametricPlot[{f[Complex @@ v + r Exp[I t]], ReIm[Complex @@ v + r Exp[I t]]}, {t, 0, 2 Pi}, PlotRange -> {{-5, 5}, {-5, 5}}, Epilog -> {Text[v, {-3, 3}]}, AspectRatio -> Automatic, Frame -> True, PlotLabel -> (Complex @@ v + r Exp[I t])], {{v, {0, 0}}, {-4, -4}, {4,...


2

What is the bug? It seems that GeoRegionValuePlot will not work correctly when two or more entities have the exact same value. Consider these examples (and ignore the legend, which is always wrong unless you give an explicit ColorFunction as below): GeoRegionValuePlot[{Entity[ "AdministrativeDivision", {"Arkansas", "UnitedStates"}] -> 1, Entity["...


6

I would create your graphics illusion with a single Graphics expression; like so With[ {color1 = RGBColor[0.569, 0.643, 0.725], color2 = RGBColor[0.902, 0.498, 0.224]}, Module[{group1, group2}, group1 = {color2, Disk[{0, 0}, 0.5], color1, Disk[{2.1, 0}, 1], Disk[{2.1 Sin[Pi/6], 2.1 Cos[Pi/6]}, 1], Disk[{-2.1, 0}, 1], ...


1

I used code from C.E comment, and it works perfectly! color = RGBColor[0.5686314191548986`, 0.6431257328883857`,0.7255014941881315`] color2 = RGBColor[0.9019616959261525, 0.49803803022437004,0.2235295987167626] g1 = Graphics[{color2, Disk[{0, 0}, 0.5], color, Disk[{2.1, 0}, 1], color, Disk[{2.1 Sin[Pi/6], 2.1 Cos[Pi/6]}, 1], color, Disk[{-2.1, 0}, 1], ...


2

If your "typical expression" is a discrete sum of sine waves, then we might treat the delta function as the "unit" of the vertical axis and plot the magnitude of the coefficients. Block[{A = 1, A2 = 1.4, ω1 = 40., ω2 = Sqrt@40.}, freqs = Cases[tf, DiracDelta[f_] :> Root[f, 1], Infinity]; DiscretePlot[ Abs[tf] /. DiracDelta -> DiscreteDelta, {ω, ...


3

Example Code color = RGBColor[0.5686314191548986`, 0.6431257328883857`, 0.7255014941881315`] color2 = RGBColor[0.9019616959261525, 0.49803803022437004, 0.2235295987167626] g1 = Graphics[{color2, Disk[{0, 0}, 0.5], color, Disk[{2.1, 0}, 1], color, Disk[{2.1 Sin[Pi/6], 2.1 Cos[Pi/6]}, 1], color, Disk[{-2.1, 0}, 1], color, Disk[{-2.1 Sin[Pi/...


2

Based on the findings from this and this answers, I can suggest the following approach. Let us make a histogram: SeedRandom[10]; hist = Histogram[RandomVariate[NormalDistribution[0, 1], 1000]] It has AspectRatio -> 1/GoldenRatio (the default): Options[hist, AspectRatio] {AspectRatio -> 1/GoldenRatio} Now we can place this histogram as ...


1

To format the plot legend you will have to go beyond PlotLegends -> Automatic. Here is an example of a formatted plot legend. VectorDensityPlot[{x, -y}, {x, -5, 5}, {y, -5, 5}, PlotLegends -> BarLegend[Automatic, LegendLabel -> "Cooper Std", LabelStyle -> {Bold, 16, FontFamily -> "Cooper Std"}]]


8

PlusMinus formats nicely, but it does not have a built-in meaning. You may work around that: h = 0.08; t = 0.13; Plot[ Evaluate[ Sqrt[(1/4) + (1/64 h^2) - x^2] - (1/8 h) + {-1, 1} ((3/8) t (1 - 2 x) Sqrt[1 - (2 x)^2]) ], {x, -.5, .5} ] If need be, you could also define your own meaning for PlusMinus: Clear[PlusMinus] PlusMinus[a__] := {-1, 1} (a)...


2

An alternative approach is to solve for t[x] instead of x[t]. t[x] /. First@DSolve[t'[x] == 1/(5 x^4 + 3 x^(-4/3)), t[x], x] /. C[1] -> 0; ParametricPlot[{Chop@%, x}, {x, 0, 3}, AxesLabel -> {t + C[1], x}, AspectRatio -> GoldenRatio] Because the ODE determines t[x] only up to an arbitrary constant, the curve above can be shifted by an ...


3

You can use RegionFunction to specify the range. Plot3D[(-1 + w + 3 s w)/(2 (-1 + w + 4 s w)), {s, 0, 3}, {w, 0, 1}, RegionFunction -> Function[{s, w, z}, (1/4 < s <= 1/2 && 1/(4 s) < w <= 1) || (s > 1/2 && 3/(2 + 8 s) < w <= 1)]]


2

Though similar to @Jess's answer, I think this will work as you want. Dynamic[PLOT,UpdateInterval->10,TrackedSymbols->{}] Because UpdateInterval only set the Max Update interval!! So as your data is updating at a almost crazy speed, the plot will sense the change of your data and update crazily as well. You have to manually tell Dynamic: don't track ...


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


4

Your Manipulate expression works for me when I change your button specification to Button["Run", pts = {{0, 0}}; func[], Method -> "Queued"] However, I think it would better to replace your unnecessarily complicated Manipulate expression with a simple DynamicModule expression. DynamicModule[{pts = {{0, 0}}, a = 10, i = 1, func}, func[] := Do[Pause[....


3

Using DiscretizeRegion[] with RegionDifference[] prior to NDSolveValue was the key. Ω = DiscretizeRegion[ RegionDifference[Rectangle[{0, 0}, {100, 100}], Rectangle[{40, 40}, {60, 60}]], Method -> "Continuation", AccuracyGoal -> 7, PrecisionGoal -> 7, MaxCellMeasure -> {"Area" -> 0.1}]; sol = NDSolveValue[{D[u[x, y], x, x] + ...


3

I think there are two different aspects here. First let add to sin signals, say, $\sin[(\omega+\Delta)t]$ and $\sin[(\omega-\Delta)t]$ Manipulate[ Plot[Sin[2 Pi (n + d) x] + Sin[2 Pi (n - d) x], {x, -5 Pi, 5 Pi}], {n, 1, 10}, {d, 0, 1}] As you can see the difference in frequency will give you beats. Now let say you want to create a Delta function like ...


4

You can replace the delta functions with something you can plot, to get some sort of visualisation. E.g. Block[{A = 1, A2 = 1.4, ω1 = 40, ω2 = -30, DiracDelta = UnitTriangle}, Plot[Abs[tf], {ω, -50, 50}]]


3

Option 1: Use the UpdateInterval option to Dynamics, i.e., Dynamic[Plot[...],UpdateInterval->n,TrackedSymbols->{}] where n is measure in seconds. Here, UpdateInterval is how often Dynamic "manually" updates the expression. By default it will also update it any time one of the symbols is changed, so you also need to set TrackedSymbols->{}. ...


3

Try something like this to define p as a function: Clear[p] p[x_, c_, d_, r_] := Module[{B}, B = ((1 - c) r)/(1 - (1 - c) r) Exp[(1 - c) r/(1 - (1 - c) r)]; Exp[-d/(1 - c) (ProductLog[0, B*(1 + x/r)^(1/d)] - ProductLog[0, B])] ] Then something like this to plot multiple instances as a function of different parameter choices: LogLogPlot[ { p[x, ...


2

Maybe like this: sol = DSolve[x'[t] == 5 x[t]^4 + 3 x[t]^(-4/3), x[t], t] eq = sol[[1, 1, 2, 0, 1]][x] == (sol[[1, 1, 2, 1]] /. C[1] -> 2) ContourPlot[sol[[1, 1, 2, 0, 1]][x] == (sol[[1, 1, 2, 1]] /. C[1] -> 2), {t, -3, 3}, {x, -3, 3}, Axes -> True, Frame -> False, AxesLabel -> {t, x[t]}] EDITED: If You exectue this code: Internal`...


2

Your initial and boundary conditions are inconsistent. Check NDSolve::ibcinc how to avoid that. Also I think you need additional boundary condition. Anyway I'm not sure your constant functions are good for boundary/initial conditions. The r domain includes zero and it gives error in your $1/r$ term. Using the recipe from above link and adding another ...


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

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


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


0

Maybe you want an interpolation of the points. You can achieve this as follows. First format your data data = {x1, x2, z}\[Transpose] and form pairs to be fitted in Interpolation later data = {#[[1 ;; 2]], #[[3]]} & /@ data Now make an interpolation function: func = Interpolation [data, InterpolationOrder -> All] Finally plot the result: ...


1

You can use ListPlot3D or ListContourPlot data = Transpose[{x1, x2, z}]; ListPlot3D[data, ColorFunction -> "Rainbow", MeshFunctions -> {#3 &}, PlotLegends -> True, AxesLabel -> {"x1", "x2", "z"}, AspectRatio -> 1] ListContourPlot[data, ColorFunction -> "Rainbow", PlotLegends -> True, FrameLabel -> {"x1", "x2"}, AspectRatio -...


1

ArrayPlot[a /. 0 -> White, ColorFunction -> "Rainbow"]


3

(This is Daniel's answer from comments; it is interesting, it answers OP's question, and it generates pretty graphics, so it seems worth preserving) Plot3D[ quad, {x, 0, 1}, {y, 0, 1}, MeshFunctions -> {#3 &}, RegionFunction -> Function[{x, y, z}, 0 < Sqrt[3] x - y && 1.72 > Sqrt[3] x + y && z > 1100], PlotStyle -&...


4

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


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.


1

Example Export["filename.png", yourgraph] Where "filename.png" filename is the name you want to give your file .png is file format and yourgraph is your Graph or Plot Alternatively, as @MarcoB has indicated you can do right-click on the plot and choose Save-as option to save your Plot or Graph as an image file.


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


0

There is an Issue on "9.0 for Mac OS X x86 (64-bit) (January 24, 2013)" There is "no" Issue on "10.0 for Mac OS X x86 (64-bit) (December 4, 2014)" ContourPlot[\[Theta]1 + \[Theta]2 == 0, {\[Theta]1, -3 \[Pi]/2, \[Pi]/2}, {\[Theta]2, -\[Pi]/2, 3 \[Pi]/2}, FrameTicks -> {{{0, \[Pi]}, None}, {{-\[Pi], 0.}, None}}, FrameLabel -> {"\!\(\*...


0

Edit, 28.06.2016 There is a Background on PlotMarkers on 10.0 for Mac OS X x86 (64-bit) (December 4, 2014) with the StandardReport style: bgc = White; ListPlot[{{1, 1}, {2, 2}}, Background -> bgc, TicksStyle -> {{12, Background -> bgc}, {12, Background -> bgc}}, Joined -> True, PlotMarkers -> Automatic] There is no Background ...


5

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


3

A tiny bit of modification on JasonB's answer Plot[f[x], {x, -2.5, 10}, Ticks -> {{1}, {1/E}}, GridLines -> Automatic, PlotStyle -> Black, AxesLabel -> {x, y}, Epilog -> {AbsolutePointSize[5], Point /@ {{1, 0}, {0, f[1]}}, Blue, Point[{1, f[1]}], Dashed, Line[{{{1, 0}, {1, f[1]}}, {{0, f[1]}, {1, f[1]}}}]}]


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


1

So your RT1 is a matrix whose rows each have five plottable regions defined by conditional expressions, but when you plot them RegionPlot[#, {x, -15, 15}, {y, -15, 15}] & /@ RT1 only some of them plot. One way to fix this is to simply use a higher number of PlotPoints RegionPlot[RT1, {x, -15, 15}, {y, -15, 15}, PlotPoints -> 50] Edit One ...


1

In such cases, it is easier to do a variable transformation. logplot[var1_, var2_, func_] := Module[{f, z1, z2, l11, l12, l21, l22}, f = func /. {var1 -> 10.^z1, var2 -> 10.^z2}; l11 = Log10[4 10^3]; l12 = Log10[10^7]; l21 = Log10[.1]; l22 = Log10[1]; ContourPlot[f, {z1, l11, l12}, {z2, l21, l22}, FrameTicks -> {Table[{x, 10^ToString[x]}, {x,...



Top 50 recent answers are included