I have a ContourPlot in mathematica which has a legend BarLegend as shown below. I have three problems with the "Tick numbers":
(1) they are interfering each other (or are too close):
probable solutions:
a. select specific numbers to show in legend bar, for example, {-1,-0.5,0,0.5,1}.
b. show the tick labels vertically in order to prevent them from interference.
c. increase the length of legend bar.
(2) I want to change tick numbers font to "Times"
(3) I defined the minimum maximum of BarLegend (-1,1) but the minimum maximum themselves are not included. (I want to have them in legend bar)
The code is plotting the distribution function f1 as a function of x and y:
f[e_, p_, v_] = 1000/(Sqrt[10 Pi]) e (e^2 - p^2) (1/v)^5 Exp[-5/2 (3 e^2 + p^2)/v^2];
plot = Show[Plot[{(1 + x)/3, -(1 + x)/3, x, -x}, {x, -1, 1},PlotRange -> {{-1, 1}, {0, 1}},FrameLabel -> {x, y},Frame -> True, ImageSize -> imagesize],ContourPlot[f[e, p, 1]/3.05, {p, -1, 1}, {e, 0, 1}, Contours -> 12,PlotLegends -> {Placed[BarLegend[{Automatic, {-1, 1}},LegendLabel ->Style["PDF", FontSize -> 14, Black, FontFamily -> "Times New Roman"]],Below]}]]
Related
For a sample size n=1000, I plot the following graph based the code
n = 1000;
m = RandomVariate[GaussianOrthogonalMatrixDistribution[Sqrt[2]/Sqrt[n], n]];
{eval, evec} = Eigensystem[m];
h = evec[[All, 1]];
imin = Ordering[eval, 1][[1]];
lambda2minlambda1 = Sort[eval][[2]] - Sort[eval][[1]];
tn = 1/(4*lambda2minlambda1);
Plot the function H1 (t)
Plot[Abs[h[[imin]]]*Exp[-2*eval[[imin]]*t]/Sqrt[Sum[h[[i]]^2*Exp[-4*eval[[i]]*t], {i, 1, n}]],
{t, 0, 10*tn},
GridLines -> {{tn}, {1}},
GridLinesStyle -> Directive[{Red, Blue}, Thickness[0.008]],
PlotRange -> Full]
Question:
How can I put all graphs for different sample size n=10, 100, 1000, 2000 in the same plot and change the color of y=1 in red?**
Try
Show[Append[Table[
m=RandomVariate[GaussianOrthogonalMatrixDistribution[Sqrt[2]/Sqrt[n], n]];
{eval,evec}=Eigensystem[m];h=evec[[All,1]];imin=Ordering[eval,1][[1]];
lambda2minlambda1=Sort[eval][[2]]-Sort[eval][[1]];tn=1/(4*lambda2minlambda1);
Plot[Abs[h[[imin]]]*Exp[-2*eval[[imin]]*t]/Sqrt[Sum[h[[i]]^2*Exp[-4*eval[[i]]*t],
{i,1,n}]],{t,0,10*tn},PlotRange->{{0,60},{0,1}}],
{n,{10,100,1000,2000}}],
Plot[1,{x,0,60},ColorFunction->Function[{x,y},Red]]],
PlotRange->{{0,60},{0,1}}]
There are always at least a dozen different ways of doing anything in Mathematica. Pick one that you can remember and use without making any mistakes.
Running the following snippet
region = ImplicitRegion[x - y + z == 0, {{x, -1, 1}, {y, -1, 1}, {z, -1, 1}}];
RegionPlot3D[DiscretizeRegion[region]]
Outputs
3D image of a plane
I want to have tick marks and to retain the functionality of RegionPlot3D (to be able to change the color, etc.). Any ideas?
Nothing preventing you from using all of the available options to RegionPlot3D documented here.
RegionPlot3D[DiscretizeRegion[region], PlotTheme -> "Detailed", Mesh -> None,
PlotStyle -> Directive[Red, Opacity[0.75]]]
I have a plot in Mathematica, and the problem is: the axes numbers of plot interfere with each other. How can I eliminate the middle numbers, For example, "5*10^12, 5*10^13, ..." and keep the main numbers "1*10^12, 1*10^13, ...". is there any other way to solve the problem?
Plot
Another option is to keep all the tick labels and rotate them:
xticks = Charting`ScaledTicks[{Log, Exp}][Log[min], Log[max]];
xticks[[All, 1]] = Exp#xticks[[All, 1]];
xticks[[All, 2]] = Rotate[#, Pi/2] & /# xticks[[All, 2]];
LogLogPlot[f[x], {x, min, max}, Frame -> True,
FrameTicks -> {Automatic, {xticks, Automatic}}, BaseStyle -> 18,
FrameLabel -> {"X", "Y"}]
Using a simple example, the ticks can be fixed like so. Referencing code from here and here.
First, the case showing overlapping labels.
f[x_] := x^2 + x^3
{min, max} = {10^-12, 10^-10};
LogLogPlot[f[x], {x, min, max}, Frame -> True,
BaseStyle -> 18, FrameLabel -> {"X", "Y"}]
Removing alternate labels.
xticks = Charting`ScaledTicks[{Log, Exp}][Log[min], Log[max]];
xticks[[All, 1]] = Exp#xticks[[All, 1]];
xticks[[All, 2]] = ReplacePart[xticks[[All, 2]],
Thread[Select[Range#Length#xticks, EvenQ] -> Spacer[{0, 0}]]];
LogLogPlot[f[x], {x, min, max}, Frame -> True,
FrameTicks -> {Automatic, {xticks, Automatic}},
BaseStyle -> 18, FrameLabel -> {"X", "Y"}]
Mathematica: Filling an infinitely deep potential well
Comment: The proper page for Mathematica questions is this one
I would like to visualize a potential well for a particle in a box in Mathematica similar to the second picture from Wikipedia here.
I have defined my function piecewise
(*Length of the box*)
L = 4;
(*Infinitly deep potential well between 0 and L*)
V[x_] := Piecewise[{
{\[Infinity], x <= 0},
{0, 0 < x < L},
{\[Infinity], L <= x}}]
and would like to obtain a plot function which gives a filled area where the potential goes to infinity.
Unfortunately my tries end up in shaded areas between the "zero region" of the potential, while I would like to have the shading in the infinity region.
Table[Plot[V[x], {x, -5, 10},
Filling -> f], {f, {Top, Bottom, Axis, 0.3}}]
The problem is that Infinity is too much for plot. So let's just give it some other big number. But to prevent it from rescaling the y axis we need to be specific with the upper plot range
Block[{\[Infinity] = 1*^1},
Plot[V[x], {x, -5, 10}, Filling -> Bottom,
PlotRange -> {Automatic, 1}]
]
Alternatively you could plot V[x]/.\[Infinity]->1*^1 instead of Block but I like Block's way better
Just give it values instead of infinity:
(*Length of the box*)L = 4;
(*Infinitly deep potential well between 0 and L*)
V[x_] := Piecewise[{{1, x <= 0}, {0, 0 < x < L}, {1, L <= x}}]
Plot[V[x], {x, -5, 10}, Filling -> Bottom]
Another way using graphic primitives:
wellLeft = 0;
leftBorder = wellLeft - 1;
rightBorder = L + 1;
wellRight = L;
top = 5;
Graphics[{
Hue[0.67, 0.6, 0.6],
Opacity[0.2],
Rectangle[{leftBorder, 0}, {wellLeft, top}],
Rectangle[{wellRight, 0}, {rightBorder, top}]
}, Axes -> True]
How can I write the code in mathematica to see the result like this:
As you see we have the complex function w=f(z), where z=x+iy and w=u+iv.
In this example w=sin z, and we see the image of vertical line x=c is hyperbola. (Left)
and the image of horizontal line y=c is an elliptic. (Right)
This picture took from the book "Complex Variables and Applications, by James Ward Brown, Ruel Vance Churchill", 8th edition: pages 331 and 333 or third edition pages 96-97
Something like this?
ClearAll[u, v, f];
f[z_] := Sin[z]
u[x_, y_] := Re#f[x + I*y];
v[x_, y_] := Im#f[x + I*y];
EDIT: This just produces the whole thing. If you want to just see what happens for a single path parallel to the imaginary axis, try
ParametricPlot[{u[5, y], v[5, y]}, {y, -3, 3}]
or for the same parallel to the real axis try
ParametricPlot[{u[x, 1], v[x, 1]}, {x, -3, 3}]
EDIT2: Interactive:
ClearAll[u, v, f];
f[z_] := Sin[z]
u[x_, y_] := Re#f[x + I*y];
v[x_, y_] := Im#f[x + I*y];
Manipulate[
Show[
Graphics[{Line[{p1, p2}]}, PlotRange \[Rule] 3, Axes \[Rule] True],
ParametricPlot[
{u[p1[[1]] + t (p2[[1]] - p1[[1]]),
p1[[2]] + t (p2[[2]] - p1[[2]])],
v[p1[[1]] + t (p2[[1]] - p1[[1]]),
p1[[2]] + t (p2[[2]] - p1[[2]])]},
{t, 0, 1},
PlotRange \[Rule] 3]],
{{p1, {0, 1}}, Locator},
{{p2, {1, 2}}, Locator}]
(ugly, yes, but no time to fix it now). Typical output:
or
The idea is that you can vary the line on the left hand side of the figures you give (by clicking around the plot, which amounts to clicking on the Argand diagram...) and see the corresponding images.
Depending on what you want to do with the representations, it might sometimes be helpful to visualize the Riemann surface in 3D. Here's the surface for w=sin(z) in 3D, neatly showing the branch cuts and the different branches (same as acl's first plot, but in 3D).
ParametricPlot3D[
Evaluate[{Re#Sin[z], Im#Sin[z], y} /. z -> x + I y], {x, -2,
2}, {y, -2, 2}]