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"}]
Related
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]}]]
I'm solving and plotting the equations of motion for the double pendulum using Mathematica's NDSolve.
I've successfully plotted the Angular position using a standard plot. But when I come to use the parametric plot for the position of each mass. I get no errors but simply no plot.
eqn1 = 2 th''[t] + Sin[th[t] - ph[t]] (ph'[t])^2 + Cos[th[t] - ph[t]] (ph''[t]) + (2 g/l) Sin[th[t]]
eqn2 = ph''[t] + Sin[th[t] - ph[t]] (th'[t])^2 + Cos[th[t] - ph[t]] (th''[t]) + (g/l) Sin[th[t]]
eqnA = eqn1 /. {g -> 10, l -> 1}
eqnB = eqn2 /. {g -> 10, l -> 1}
sol = NDSolve[{eqnA == 0, eqnB == 0, th[0] == 0.859, th'[0] == 0, ph[0] == 0.437, ph'[0] == 0}, {th, ph}, {t, 0, 10}]
Plot[{th[t], ph[t]} /. sol, {t, 0, 10}]
r1 = {lSin[th[t]] + lSin[ph[t]], -lCos[th[t]] - lCos[ph[t]]} /. {l -> 1, g -> 10}
ParametricPlot[r1 /. sol, {t, 0, 10}]
Replace
r1 = {lSin[th[t]] + lSin[ph[t]], -lCos[th[t]] - lCos[ph[t]]} /. {l->1, g->10}
with
r1 = {l*Sin[th[t]] + l*Sin[ph[t]], -l*Cos[th[t]] - l*Cos[ph[t]]} /. {l->1, g->10}
and your ParametricPlot should appear.
One useful trick you might remember, when any plot doesn't appear you can try replacing the plot with Table and see what it shows. Often the table of data provides the needed hint about why the plot isn't appearing.
Hello and thanks in advance,
I came upon an issue trying to plot a piecewise function in Mathematica. When entered directly into the Plot function, the piecewise did NOT plot. However, when I defined the piecewise as a variable, it did plot. Why is this issue occurring and can I still join my plot? (I would like to join it by setting exclusions to none)
The following is my code: (I define a Maxwell strain function and am trying to model the plastic deformation of a polymer over multiple stress cycles)
z = 2*10^10;
h = 10^12;
MaxwellStrain[s_, t_] := s/z + (s*t)/h;
stress = {0, 10^7, -10^7, 5*10^6, 10^7, -5*10^6};
time = {0, 100, 200, 300, 400, 500};
strainList = Join[{0}, Table[MaxwellStrain[stress[[i + 1]], t - time[[i]]], {i, 1, 5}]];
Plot[
Piecewise[
Table[{
Total[strainList[[1 ;; i + 1]]], time[[i]] < t < time[[i + 1]]},
{i, 1, 5}
],
Exclusions -> none]
,
{t, 0, 500}
]
x = Piecewise[
Table[{
Total[strainList[[1 ;; i + 1]]], time[[i]] < t < time[[i + 1]]},
{i, 1, 5}
],
Exclusions -> none]
Plot[x, {t, 0, 500}]
The following is my output: (first plot doesn't show, the second does)
output:
Thank you for the help,
SV
I have a time domain data. After I did discrete fourier transform with Periodogram, how can I output the plot into a list for further manipulation?
Periodogram[data[[All, 2]], SampleRate -> 3000000/0.01, GridLinesStyle -> Directive[Red, Dashed], PlotRange -> {{100000000 - 10000, 100000000 + 10000}, All}]
Thanks!
A List can be extracted from the Periodogram output, based on its InputForm, as follow. (We begin with some made-up data.)
data = Table[2 Sin[0.2 \[Pi] n ] + Sin[0.5 \[Pi] n] + RandomReal[{-1, 1}], {n, 0, 127}];
plot = Periodogram[data, SampleRate -> 3000000/0.01,
GridLinesStyle -> Directive[Red, Dashed]];
Next, we use Position to locate the desired quantities within the plot and extract them.
plot[[First#Position[plot, Line] /. {0 -> 1} /. List -> Sequence]]
(* {{0., -8.99487}, {2.38095*10^6, 1.60543}, {4.7619*10^6, 1.82102}, ... *)
There is usually an associated function in instances like this. In this case PeriodogramArray outputs the data.
data = Table[
2 Sin[0.2 Pi n ] + Sin[0.5 Pi n] + RandomReal[{-1, 1}],
{n, 0, 127}];
Periodogram[data]
magdata = PeriodogramArray[data];
ListLinePlot[10 Log[10, magdata], PlotRange -> {{0, Length[magdata]/2}, All}]
I am attempting to graph the following function and indicate on the plot where the function passes 45 degree slope. I have been able to graph the function itself using the following code:
T = 170 Degree;
f[s_, d_] = Normal[Series[Tan[T - (d*s)], {s, 0, 4}]];
r[h_, d_] = Simplify[Integrate[f[s, d], {s, 0, h}]];
a[h_] = Table[r[h, d], {d, 1, 4, .5}];
Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 4}, {0, -4}}, AspectRatio -> 1]
I need to display the point on each curve where the slope exceeds 45 degrees. However, I have thus far been unable to even solve for the numbers, due to something odd about the hadling of tables in the Solve and Reduce functions. I tried:
Reduce[{a'[h] == Table[-1, {Dimensions[a[h]][[1]]}], h >= 0}, h]
But I apparently can't do this with this kind of function, and I am not sure how to add these results to the plot so that each line gets a mark where it crosses. Does anyone know how to set this up?
Here is your code, for completeness, with plot parameters slightly modified to zoom into the region of interest:
Clear[d,h,T,f,r,a];
T = 170 Degree;
f[s_, d_] = Normal[Series[Tan[T - (d*s)], {s, 0, 4}]];
r[h_, d_] = Simplify[Integrate[f[s, d], {s, 0, h}]];
a[h_] = Table[r[h, d], {d, 1, 4, .5}];
plot = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 0.8}, {0, -0.5}},
AspectRatio -> 1, Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10],
PlotStyle -> {Thickness[0.004]}]
Here is the code to get the solutions (h-coordinates):
In[42]:= solutions = Map[Reduce[{D[#, h] == -1, h >= 0}, h] &, a[h]]
Out[42]= {h == 0.623422, h == 0.415615, h == 0.311711, h == 0.249369,
h == 0.207807, h == 0.178121, h == 0.155856}
Now produce the plot:
points = ListPlot[MapIndexed[{#1, a[#1][[First##2]]} &, solutions[[All, 2]]],
PlotStyle -> Directive[PointSize[0.015], Red],
PlotRange -> {{0, 0.8}, {0, -0.5}}, AspectRatio -> 1,
Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10]]
Finally, combine the plots:
Show[{plot, points}]
Edit:
Responding to the request of cutting plots at the found points - here is one way:
plot =
With[{sols = solutions[[All, 2]]},
Plot[Evaluate[a[h]*UnitStep[sols - h]], {h, 0, 4},
PlotRange -> {{0, 0.8}, {0, -0.5}}, AspectRatio -> 1,
Frame -> {False, True, True, False},
FrameStyle -> Directive[FontSize -> 10],
PlotStyle -> {Thickness[0.004]}]]
and this should be executed after the solutions have been found.
Could find the points via:
slope45s =
h /. Map[First[Solve[D[#, h] == -1 && h >= 0, h]] &, a[h]]
Out[12]= {0.623422, 0.415615, 0.311711, 0.249369, 0.207807, 0.178121, \
0.155856}
Here we put together the list of relevant points.
pts = Transpose[{slope45s, Tr[a[slope45s], List]}]
Can now plot in any number of ways. Here is one such.
p2 = ListPlot[pts, PlotRange -> {{0, 4}, {0, -4}},
PlotStyle -> {PointSize[.01], Red}];
p1 = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 4}, {0, -4}},
AspectRatio -> 1];
Show[p1, p2]
(Being new to this modern world-- or rather, of an age associated with an earlier civilization-- I do not know how to paste in an image.)
(Okay, thanks Leonid. I think I have an image and also indented code.)
(But why are we talking in parentheses??)
Daniel Lichtblau
Wolfram Research
Edit: I did not much like the picture I gave. Here is one I think is more descriptive.
makeSegment[pt_, slope_, len_] :=
Rotate[Line[{pt + {-len/2, 0}, pt + {len/2, 0}}], ArcTan[slope]]
p2 = ListPlot[pts, PlotStyle -> {PointSize[.01], Red}];
p1 = Plot[a[h], {h, 0, 4}, PlotRange -> {{0, 2}, {0, -1}},
AspectRatio -> 1];
p3 = Graphics[Map[{Orange, makeSegment[#, -1, .2]} &, pts]];
Show[p1, p2, p3, AspectRatio -> 1/2, ImageSize -> 1000]