New answers tagged plotting
1
Maybe with some or all of these changes:
ReImPlot[ (* the solution is complex-valued *)
id /. FindRoot[(id - (Cap*W*mu*(n*vth)^2)/(7*10^-6)*(PolyLog[
2, -Exp[(vd - id - vg + vt)/(n*vth)]] -
PolyLog[2, Exp[(id - vg + vt)/(n*vth)]])),
{id, Sign[vd] 10^6} (* better starting point *)
],
{vd, -10^8, 10^8}, (* ...
4
The delta_function(t-t0) is used as an operator multiplied by some other function g(t) inside a definite integral over all t from plus to minus infinity and maps the function g(t) to a specific value g(t0) determined by the zero argument of the delta_function. To illustrate this look for example with a function t Cos[t] at
Integrate[(e/(Pi*((t - t0)^2 + e^...
2
You might consider SliceVectorPlot3D with "BackPlanes" as the second argument:
e = {Cos[π x/5] Sin[π y / 4], Sin[π x / 5] Cos[π y/4], Sin[π x / 5] Sin[π y / 4]};
SliceVectorPlot3D[e, "BackPlanes", {x, -2, 2}, {y, -2, 2}, {z, -2, 2}]
3
Introduction
I recently had to do something similar, and figured I'd share my method - hopefully it's useful for people stumbling on this question.
As this was project-specific, I didn't really bother making this take a general directed acyclic graph as input. I will try and revisit this when I find time to do so.
Also, just for fun, let's make two 'mirrored'...
2
You have a number of problems in your code.
Mathematica reserves uppercase N and O, you can't reassign them (well, at least not easily). You don't really need them.
Your code doesn't define 3 plots, so the Show can't show 3 curves.
That said you can avoid the Show completely.
Also, you've used Insert instead of Inset in the Epilog assignments.
c = 2.998 10^...
1
Here is a solution described in: Smooth convex hull of a large data set of 3D points.
mve[pts_?MatrixQ, tol_ : 1.*^-8] :=
Module[{prec = Precision[pts], bet, bm, c, d, del, dp, h, j, kap, n,
qj, qm, sc, sig, u, zero},
zero = SetPrecision[0, prec]; {n, d} = Dimensions[pts]; dp = d + 1;
qm = PadRight[pts, {n, dp}, N[1, prec]];
u = N[ConstantArray[...
1
In versions 11.+, we can use System`DateListPlotDump`DateTicks to get date ticks:
SeedRandom[2021];
data = Transpose[{RandomReal[{3250368000, 3250454400}, 10000],
RandomReal[{0, 100}, 10000]}];
SmoothHistogram3D[data, ImageSize -> Large,
Ticks -> {System`DateListPlotDump`DateTicks[{##}, 7,
{"MonthNameShort", " ", &...
2
We can use the function System`DateListPlotDump`DateTicks to generate date ticks. Its argument pattern is:
System`DateListPlotDump`DateTicks[{mindate, maxdate}, ndivisons] (* or *)
System`DateListPlotDump`DateTicks[{mindate, maxdate}, ndivisons, labelformat]
Example:
data1 = TimeSeries[{1, 1, 2, 3, 5, 8, 11}, {"Jan 1, 2015"}];
data2 = TimeSeries[{...
2
ClearAll[addHatchFilling]
addHatchFilling[meshfunctions_: Automatic, meshstyle_: Automatic,
mesh_: Automatic, meshshading_: Automatic] :=
ReplaceAll[p_Polygon :> {p,
First[RegionPlot[DiscretizeRegion[p],
MeshFunctions -> (meshfunctions /. Automatic -> {# + #2 &}),
MeshStyle -> (meshstyle /. Automatic -> Directive[...
5
This is a possibility for what you want:
c = 2.998 10^8 ;
h = 6.62607015 10^-34 ;
Kb = 1.380649 10^-23 ;
i[l_, T_] := (2 Pi h c^2)/(l^5 (Exp[(h c)/(l Kb T)] - 1));
Plot[{i[l, 3000], i[l, 4000],i[l, 5000]}, {l, 0, 2.5 10^-6}, PlotRange -> All]// Quiet
I added //Quiet in the end because it complained about having to deal with such small numbers.
For ...
6
Lewin's book gives a useful continuation formula:
$$\operatorname{Li}_n^{(k_0,\dots,k_{n-1})}(z)=\operatorname{Li}_n(z)+\frac1{(n-1)!}\sum_{m=0}^{n-1}k_m\binom{n-1}{m}(2\pi i)^{m+1}(\log z)^{n-m-1}$$
which can be used to visualize the Riemann surface of the dilogarithm:
With[{ε = 1*^-12},
GraphicsRow[{ParametricPlot3D[Flatten[Table[{r Cos[φ], r Sin[φ],
...
6
Often these graphics commands are a bit obscure and one has to try. Is the following approx. what you are looking for?:
ListPlot[{{2, 5, 2, 8, 6, 8, 3}, {1, 2, 5, 2, 3, 4, 3}},
PlotMarkers -> {"\[SixPointedStar]", 15}, Joined -> True,
PlotStyle -> {Orange, Green},
PlotLegends ->
Placed[LineLegend[{"line1", "line2&...
9
Space for the legend is available at the upper left
ListPlot[{
{2, 5, 2, 8, 6, 8, 3},
{1, 2, 5, 2, 3, 4, 3}},
PlotMarkers -> {"✶", 15},
Joined -> True,
PlotStyle -> {Orange, Green},
PlotLegends ->
Placed[
LineLegend[{"line1", "line2"},
LegendFunction -> "Frame"],
{.15, .8}],
Frame -&...
8
You did not put any location for Placed
ListPlot[{{2, 5, 2, 8, 6, 8, 3}, {1, 2, 5, 2, 3, 4, 3}},
PlotMarkers -> {"\[SixPointedStar]", 15}, Joined -> True,
PlotStyle -> {Orange, Green},
PlotLegends -> Placed[LineLegend[{"line1", "line2"},
LegendFunction -> (Framed[#, FrameMargins -> 0] &)], {0.1, 0.5}...
2
I'd like to refer to the Maple documentation on this topic. I think so does Mathematica. Also consider the Riemann surface for PolyLog[2, z].
2
The axes are scaled to the data. If only want to change the axes with the same data you may use PlotRange:
ListLogLogPlot[Range[20]^3, Frame -> True,
FrameTicks -> {{PowerTicks[True],
PowerTicks[False]}, {PowerTicks[True], PowerTicks[False]}},
PlotRange -> {{10^-5, 10^5}, {10^-5, 10^5}}]
However, MMA does this automatically if the data ...
1
The old school way is to plot the Re and Im part separately. Or you can plot them parametrically as @LouisB suggested.
f[t_] = Exp[-I t]
Plot[{Re[f[t]], Im[f[t]]}, {t, -20, 20}]
ParametricPlot[{Re[f[t]], Im[f[t]]}, {t, -20, 20}, AxesLabel -> {"Re", "Im"}]
If you are using V12, then you can use ReImPlot
ReImPlot[f[t], {t, -20, 20}]
3
1. You can construct your own ticks using FindDivisions:
fd = FindDivisions[{0, 70}, {7, 6}];
majorticks = Thread[{fd[[1]], 1945 + fd[[1]], {.025, .0}}, List, 2];
minorticks = Thread[{Flatten[Complement[#, First@fd] & /@ Last[fd]],
Spacer[0], {.015, 0}}, List, 1];
Plot[123456789 Exp[Log[163123123/123456789]/9 x], {x, -2, 69},
Frame -> True,
...
2
I'm late into this, but
plot = Plot[..., PlotLegends -> {...}]
Export["file.pdf", plot]
works fine for me in v12. (C.E.'s answer of Save selection as... puts an "Out[#]" on the side). So exporting to a PDF file could be a solution if one does not want to rasterize.
4
SeedRandom[1]
xy = RandomSample[Tuples[Range[0, 10], 2], 10];
z = RandomReal[1, 10];
xyz = Join[xy, List /@ z, 2]
{{9, 5, 0.941699}, {7, 3, 0.294264}, {1, 3, 0.188274}, {0, 0, 0.761529},
{6, 1, 0.169824}, {0, 3, 0.455359}, {5, 10, 0.75425}, {9, 1, 0.268291},
{2, 1, 0.147377}, {8, 9, 0.480659}}
Graphics
graphics = Graphics[{EdgeForm[Gray], Hue @ #3, ...
1
Have a look for example at a tutorial for what is behind the question: Ternary Contour. So this works not on functions but on numerical data series from tables. Like in this demonstration composition of vapor and liquid phases for a ternary ideal mixture this is then intepreted as function of values, for example an interpolation function, over the ...
0
On a side note (but too big to fit in a comment), you can speed up the Jschottky function evaluation by about 13x by using FunctionCompile:
f = Function[{Typed[V, "Real64"], Typed[T, "Integer64"]},
Module[{q, me, h, kb},
q = 1.6*10^-19;
me = 9.1*10^-31;
h = 6.63*10^-34;
kb = 1.38*10^-23;
(2 q*(2 \[Pi] me)^0.5 kb^1.5)/h^2*(...
2
Here is your corrected code, try to understand it. Note that the zeros are mostly real. And if they are complex, the imaginary part is very small. Maybe you want to change the parameters?
Manipulate[
zeros = NSolve[{6 \[Alpha] (2 z \[Alpha] + \[Xi] - \[Nu] Conjugate[
z]) + (2 z \[Alpha] + \[Xi] - \[Nu] Conjugate[z])^3 ==
0 && ...
3
Here is an example with Overlay[]:
Manipulate[
With[{a =
If[m2 > m1 (\[Mu] Cos[\[Theta]] + Sin[\[Theta]]), (
9.8 (m2 - \[Mu] m1 Cos[\[Theta]] - m1 Sin[\[Theta]]))/(
m1 + m2), (
9.8 (m2 + \[Mu] m1 Cos[\[Theta]] - m1 Sin[\[Theta]]))/(m1 + m2)],
T = If[m2 > m1 (\[Mu] Cos[\[Theta]] + Sin[\[Theta]]), (
9.8 m1 m2 (1 + \[Mu] Cos[\...
4
It is not possible to override the Quiet run of the command Plot. However, you can intercept the messages and store them in a list to be browsed afterwards.
For example,
errorlst = {};
Plot[if[t], {t, 0, 10},
EvaluationMonitor :>
If[Length[$MessageList] > 0,
AppendTo[errorlst, {$MessageList[[-1]], t}]]
]
To get the error messages later on, do:...
2
Piecewise is the usual go-to for this sort of plotting:
f1[x_] := Piecewise[{
{x^2, x > 0},
{-50, x <= -2}
}
]
Plot[
f1[x],
{x, -10, 10},
Exclusions -> None
]
EDIT:
Also, if you were really dead set on using If, you would have to nest multiple If statements like this:
Plot[
If[x <= -2, -50, If[x > 0, x^2, 0]],
{x, -10, 10},...
1
This can be solved with Which[] and creating a function. It is used as Which[Condition == True, Action, Condition2 == True, Action, ..., ...]
Which[test1,value1,test2,value2,...]
Evaluates each of the test_i in turn, returning the value of the value_i corresponding to the first one that yields True.
f[x_] := Which[x > 0, Return[x^2], x <= -2, Return[-...
1
I think your data is too "coarse" to show the detail in your desired display. In addition, the vast majority of values are right at 2.6 (ranging only between 2.58599 to 2.61434). Then there are just a few values around 5.0 (ranging only between 4.97879 to 5.01542). So there's a huge gap between the two sets of numbers. Here's a plot of the grid ...
4
This system can be solved exactly using DSolve.
Clear["Global`*"]
$Version
(* "12.2.0 for Mac OS X x86 (64-bit) (December 12, 2020)" *)
Use exact values for the known parameters,
B = 2/5; C2 = 1/2; F = 3/5;
eqns = {y''[x] + A*y'[x] + B*y[x] + C2*y[x] == 0,
y[1] == 1, y'[0] == -1/5};
sol = DSolve[eqns, y, x];
Verifying the ...
1
Use sol to define a function func. Then you can use InverseFunction[func]
func[t_] := a[t] /. sol[[1]]
Plot[func[t], {t, 0, 500}]
func[432]
3.002
InverseFunction[func][3.002]
431.9649
3
Here's an approach that is a little non-precise mathematically but maybe more aesthetic:
sol = NDSolve[{
x'[t] == -y[t] + x[t] (α[t] - (x[t]^2 + y[t]^2)),
y'[t] == x[t] + y[t] (α[t] - (x[t]^2 + y[t]^2)),
α'[t] == -0.1,
x[-50] == 1, y[-50] == 1, α[-50] == 25}, {x, y, α}, {t, 0, 400}][[1]];
ParametricPlot3D[{α[t], x[t], y[t]} /. sol, {t, 0, 400}, ...
5
sol = ParametricNDSolve[{D[x[t], t] == -y[t] +
x[t] (α - (x[t]^2 + y[t]^2)),
D[y[t], t] == x[t] + y[t] (α - (x[t]^2 + y[t]^2)),
x[0] == a, y[0] == b}, {x, y}, {t, 0, 10}, {a, b, α}];
{x0, y0} = {1, 1};
ParametricPlot3D[
Table[{x[x0, y0, α][t], α, y[x0, y0, α][t]} /.
sol, {α, -10, 10, 2}], {t, 0, 10},
AxesLabel -> {x, α, y}, ...
0
The problem is that an infinite arrangement of labels exists and I doubt any degree of programming can offer all that a user can imagine. If one does not like the straightforward result of FrameLabel, as in Plot[x^2, {x, -10, 10}, Frame -> True, FrameLabel -> {None, Style["S", FontFamily -> "Helvetica", Black, Bold, 20], None, ...
2
Plot works with logical statements, for instance
Plot[If[x>0,x^2,0],{x,-10,10}]
Also see Piecewise or Switch instead of nesting Ifs for multiply defined functions.
3
This should show you how to do it.
Manipulate[
If[x, Plot[Sin[2 π t], {t, 0, 1}], 0],
{x, {True, False}, Setter}]
Or, perhaps, this will be closer to the answer you are looking for:
With[{x = True}, If[x, Print[Plot[Sin[2 π t], {t, 0, 1}]], 0]]
The above will will show your plot, and this will return zero.
With[{x = False}, If[x, Print[Plot[Sin[2 π t], ...
4
Use arbitrary-precision rather than machine precision by specifying the WorkingPrecision.
Clear["Global`*"]
$Version
(* "12.2.0 for Mac OS X x86 (64-bit) (December 12, 2020)" *)
ComplexPlot3D[Sin[z]/MittagLefflerE[10, z], {z, -1 - I, 8 + I},
Exclusions -> None, PlotPoints -> 50, WorkingPrecision -> 15]
4
A cheap way to get what you want is to use Lighter[] along with "RedBlueTones" and an appropriate bell-shaped curve:
LinearGradientImage[Function[x, Lighter[ColorData["RedBlueTones", x],
Sech[5 (x - 1/2)]]], {300, 30}]
ContourPlot[x y, {x, -1, 1}, {y, -1, 1},
ColorFunction -> (...
2
Some bells and whistles.
Clear["Global`*"]
Since the "parameters ... are adjustable" use Manipulate.
Manipulate[
Module[{s1, θ, eqn},
s1 = θ*Cot[θ] + I*ν*θ;
eqn = σ + (λ*s1);
ParametricPlot[
{Re[eqn], Im[eqn]},
{θ, -Pi, Pi},
PlotRange -> {{-5, 3.5}, {-4.25, 4.25}},
AspectRatio -> 1]],
{{σ, 1}, 0, 2, 0.01, ...
8
How about
French = Blend[{{0, Blue}, {1/2 - 0.1, White},
{1/2 + 0.1, White}, {1, Red}}, #1] &;
Then
French /@ (Range[15]/15.)
ContourPlot[x, {x, 0, 1}, {y, 0, 1}, ColorFunction -> French]
Any variation is possible: e.g.
French2 = Blend[{{0, Darker[Blue, 0.7]}, {0.15, Blue}, {1/2 - 0.05,
White},
{1/2 + 0.05, White}, {0.9, Red}, {1,...
4
Start from here:
σ = 1;
λ = 1/2;
ν = 1;
s1 = θ Cot[θ] + I ν θ;
eqn = σ + (λ s1);
ParametricPlot[{Re[eqn], Im[eqn]}, {θ, -3.5, 3.5}, AspectRatio -> 1]
1
ContourShading -> None and remove ColorFunction -> "DarkRainbow"
contourPotentialPlot1 =
ContourPlot[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 +
0.275 h^2 s^2 + 0.125 s^4, {h, -400, 400}, {s, -300, 300},
PlotRange -> {-1.4*10^8, 2*10^7}, Contours -> 15, Axes -> False,
PlotPoints -> 30, PlotRangePadding -> 0, Frame -...
0
a[f_] := 25000/(1 + (I*f)/200)
ReImPlot[a[f], {f, 0.1, 10000}, PlotRange -> All,
ScalingFunctions -> {"Log", None},
PlotLegends -> Placed[Automatic, {.35, .6}]]
LogLogPlot[Abs[a[f]], {f, 0.1, 10000}, PlotRange -> All]
1
Clear["Global`*"]
f1[theta_, phi_] = Sin[3 theta] Cos[phi];
f2[theta_, phi_] = Cos[theta] Sin[phi];
List1 = Flatten[
Table[{{theta, phi}, f1[theta, phi]}, {theta, 0, Pi, Pi/10}, {phi,
0, 2 Pi, 2 Pi/10}], 1];
List2 = Flatten[
Table[{{theta, phi}, f2[theta, phi]}, {theta, 0, Pi, Pi/10}, {phi,
0, 2 Pi, 2 Pi/10}], 1];
funcs = ...
2
You are not getting a plot because you have serious numerics problems in your code. The values of the functions FE, FS and R1 are often far beyond the range that can be represented by machine arithmetic. You need to re-express your code so it can make use of the Wolfram Languages arbitrary precision arithmetic. I am not going to do that for you. What I will ...
2
Plot will default to a PlotRange that shows what it believes is the likely region of interest. If the default is not your region of interest, then you must override the default by specifying the PlotRange.
Clear["Global`*"]
k1 = 10;
k2 = 2;
S = 100;
c1 = 2*Pi;
c2 = 1;
alpha = 0;
e = 2/10;
c = 5;
eqncub = k1*th + k2*th^3 -
Pdyn*S*e*c*(c1*(...
3
Generally the answer is AxesOrigin -> {0, 0}, but sometimes PlotRange -> All as Mariusz Iwaniuk mentioned might works as well.
Regard your second question about Why Mathematica changes the plot range automatically and how it determines?, is above my knowledge to answer it comprehensively but this is what I find:
AxesOrigin documentation states:
In 2D ...
1
Let's start by creating some example datasets:
signal = Table[Sin[x], {x, Subdivide[0, 2 Pi, 100]}];
noise = {
RandomVariate[NormalDistribution[0.2, 0.1], 101],
RandomVariate[NormalDistribution[0.1, 0.2], 101],
RandomVariate[NormalDistribution[0.4, 0.3], 101],
RandomVariate[NormalDistribution[-0.1, 0.3], 101],
RandomVariate[NormalDistribution[-...
3
The same issue arises when we use CalloutMarker -> Arrowheads[Medium] or CalloutMarker -> Arrowheads[.02] in combination with Manipulate andImageSize -> Full.
A simple fix is to use ImageSize -> Scaled[1] instead of ImageSize -> Full:
Manipulate[Plot[Callout[x, "x", CalloutMarker -> "Arrow"], {x, 0, 1},
ImageSize ->...
8
You should learn to cut out parts bit by bit until there is nothing left to cut that does not remove the problem. You can reduce the problem to this (the rest just obscures the problem):
Plot[eq2, {x, -1.1, 1.1}, Method -> "BoundaryOffset" -> False]
It comes from subtractive cancellation.
ClearAll[ff];
ff[x_?NumericQ] := Last@Sow[{x, eq2}];
...
4
To understand why the plot you made (which is correct although distorted) looks like it does and also see the region that really interests you without distortion, make use of the options AspectRatio and Contours. Like so:
ContourPlot[(x - 1)^4 + (2 x + y)^2, {x, -2, 4}, {y, -14, 9},
AspectRatio -> Automatic,
Contours -> 2^Range[-2, 6],
ImageSize -...
Top 50 recent answers are included
