New answers tagged plotting
1
Since you didn't provide y I made one up. You can combine them all into a single Plot and use Directive. I also took the liberty of changing AxesLabel to FrameLabel and disabling RotateLabel and adding the legends.
y = k^3/2 + I Log[k + 1]/Sqrt[xi];
Plot[{Im[y] /. {xi -> .5}, Im[y] /. xi -> 10,
Im[y] /. xi -> 1000}, {k, 0, 100},
PlotRange -> ...
2
You can use Show to combine multiple plots:
plot1 = Plot[Sin[3 x], {x, -Pi, Pi}, PlotStyle -> Dashed]
and
plot2 = Plot[Sin[2 x]*Cos[x], {x, -Pi, Pi}, PlotStyle -> Red]
then
Show[{plot1, plot2}]
delivers:
2
Credit goes to user flinty in the comments who suggested a more concise and accurate way to find the matches with RegionEqual. It also thankfully appears to correct the matching issue. Still don't know what the root cause was but happy to have learned a way to use RegionEqual in a pattern conditional.
matchingLogic[oldpolygons_, newpolygons_] :=
Flatten[...
3
I'm not sure if the definitions you posted are different from the ones used in your plot, or you have lingering definitions that are interfering, but the plot I get from your code is slightly different than the one you show.
Z1D[\[Beta]_, \[Xi]_, \[Theta]_] = (1/\[Xi] (2/\[Beta]^2 -
1) + ((\[Theta] Exp[-\[Beta]])/2 - 1/2) +
Sum[((-\[Beta])^n \[...
1
The numbers involved with these equations are definitely a bit tricky, and if your real equations are more complex it will no doubt take some playing around to find the correct parameters. So I'll show you my general process.
First, I generate some data and define a model. I exclude 0 here because it generates infinity.
x[t_] := Log[t]/Ceiling[t] + 32
y[t_]...
1
texts = MapThread[Text[Style["Range "<>#, 20, FontFamily -> Times], #2, {0, 0}, {0, 1}]&,
{{"1", "2", "3"}, {{1, 57}, {2, 58}, {2.75, 59}}}];
epilog = {texts,
First @ Plot[nlm[log10q], {log10q, Min[data[[All, 1]]], Max[data[[All, 1]]]}]};
legend = Placed[
LineLegend[{Red, ColorData[97][1]}, {"Data", "Fit"},
Joined -> {False, ...
3
Thanks to the suggestions of @MarcoB I was able to do it. Here's one way to do it:
Show[ListPlot[data, PlotStyle -> {Red, AbsolutePointSize[6]},
Frame -> True, Axes -> False, FrameStyle -> 16, ImageSize -> Large,
GridLines -> Automatic, GridLinesStyle -> Lighter[Gray, .8],
FrameLabel -> (Style[#, 20, Bold] & /@ {...
2
Let me know if this is the output you were expecting:
ρ1c1[n_, m_, c_, x_, α_] := 1 + x ((1/(x - (c/n)^(1/α))) + (1/(-x + (c/m)^(1/α))))
ρ1c2[n_, m_, c_, x_, α_] := 1 - x (n/c)^(1/α)
ρ1c3[n_, m_, c_, x_, α_] := 0 c
ρ1c4[n_, m_, c_, x_, α_] := 0 c
π1c1[n_, m_, c_, x_, α_] := (n ρ1c1[n, m, c, x, α]/x)
π1c2[n_, m_, c_, x_, α_] := (n ρ1c2[n, m, c, x, α]/x)
π1c3[...
4
A few additional alternatives:
ParametricPlot3D[{v x Sin[x], v x Cos[x], -2 x /3},
{x, 0, (11/4)*Pi}, {v, 1, 1.15},
PlotStyle -> Darker[Blue], Mesh -> None, PlotPoints -> 100]
ParametricPlot3D[{v x Sin[x], v x Cos[x], -2 x /3},
{x, 0, (11/4)*Pi}, {v, 0, 1.15},
PlotStyle -> None, PlotPoints -> 100,
MeshFunctions -> {#5 &},...
1
This is what i have been able to do so far.
$\alpha(t)$ over the surface of the upper-half $\mathcal{S}^2$.">
and here is the code
Clear[c1, s1]
c1 = ParametricPlot3D[{1 + Cos[t], Sin[t], 2*Sin[t/2]}, {t, 0,
2 \[Pi]},
PlotStyle -> {Directive[Red, Thickness[0.005]],
Arrowheads[{0, 0.05, 0.05, 0.05, 0}]}, PlotRange -> All,
BoxRatios -> {2, ...
1
One way is to place both the Shows inside a Column within Manipulate (not quite clear to me if the two graphics in a column is acceptable to you).
p1 = Plot[Cos[\[Theta]], {\[Theta], 0, 2 Pi}];
p2 = VectorPlot[{
(3 Cos[ArcTan[x/y]] Sin[ArcTan[x/y]]),
(2 Cos[ArcTan[x/y]] Cos[ArcTan[x/y]] -
Sin[ArcTan[x/y]] Sin[ArcTan[x/y]])
},
{x, -2, 2},
{...
0
You have an extra value of IF for the number of values of VF you had, so I am commenting out the last one in your data. Also, rather than Riffle and Partition, I'd obtain the same thing with Transpose.
IF = {0., 0., 0.02, 0.25, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12(*, 13*)};
VF = {0.2, 0.3, 0.4, 0.5, 0.576, 0.603, 0.624, 0.636, 0.646,
0.654, 0.661, 0....
4
One easy way is to let ParametricPlot linearly interpolate between the two curves:
f1 = {x*Sin[x], x*Cos[x], -((2*x)/3)};
f2 = {1.15*x*Sin[x], 1.15*x*Cos[x], -((2*x)/3)};
ParametricPlot3D[{
lambda f1 + (1 - lambda) f2
},
{x, 0, (11/4)*Pi},
{lambda, 0, 1},
PlotStyle -> Darker[Blue],
Mesh -> None
]
3
Assuming you're looking for the point with maximal curvature in your LogPlot try
kappa = f''[x]/Sqrt[1 + f'[x]^2]^3 /. f -> (Log[modelfn[#]] &) (*curvature*)
max = NMaximize[kappa, x]
(*{0.55445, {x -> 0.692045}}*)
Show[{LogPlot[modelfn[x], {x, 0, 500}, PlotRange -> {{0, 500}, {10^(-7), 10^(-4)}}],
Graphics[{Red, PointSize[.02], Point[{x, Log[...
2
Thanks to MarcoB I was able to create a function that does the job:
xRange = Range[-4, 4, 0.1];
testvalues = {#, Sin[#]} & /@ xRange;
spins = Sin /@ xRange;
ListLinePlot[testvalues, ColorFunction -> (
Blend[{Green, Red}, Rescale[spins[[1 + Round[#1*(-1 + Length@xRange)]]], {-1, 1}]] &)]
I am not too familiar with the mechanisms behind the ...
5
In MATLAB, what I generally use, you can just use the 'hold on'
command.
There is no hold on in Mathematica, but you can add a point to a plot in many ways. One is to use Epilog
Code
Clear["Global`*"];
fx[a_, b_, c_, d_, u_, L0_, x_, y_] := x*(L0 - a*x - b*y)
fy[a_, b_, c_, d_, u_, L0_, x_, y_] := y*(u - c*x - d*y);
xCoord[a_, b_, c_, d_, u_, L0_] := (...
1
I do not use VectorPlot3D, but playing with some options, you can try changing VectorScaling
VectorPlot3D[{40, 0, 0}, {x, 0, 1000}, {y, 0, 1000}, {z, 0, 1000}]
Compare to
VectorPlot3D[{40, 0, 0}, {x, 0, 1000}, {y, 0, 1000}, {z, 0, 1000},
VectorScaling -> Automatic]
You can also use default, and change VectorMarkers
VectorPlot3D[{40, 0, 0}, {x, 0, ...
1
See if the following works for you (I made up a matrix that depends on lambda since none was provided):
ClearAll[m]
m[lambda_] := {{1 + lambda, 2 lambda, 3},
{3 + lambda^2, 1 - lambda, 2},
{2, -1, 3 lambda}}
DiscretePlot[Evaluate@Eigenvalues@m[l], {l, 1, 10}, Filling -> ...
0
If you want a frame around the whole legend
ListPlot[data, PlotStyle -> {Red, AbsolutePointSize[6]},
PlotLegends ->
Placed[PointLegend[{Style["All Data", 14]},
LegendFunction -> (Framed[#, FrameStyle -> Thick,
FrameMargins -> Tiny] &)], {0.2, 0.8}], Frame -> True,
Axes -> False, FrameStyle -> 16, GridLines -&...
0
How can I put a frame to the legend (e.g "All Data") keeping the same
position?
ListPlot[data,
PlotStyle -> {Red, AbsolutePointSize[6]},
PlotLegends -> Placed[LineLegend[{"All Data"},
LegendFunction -> (Framed[Style[#]] &)], {0.2, 0.8}],
Frame -> True,
Axes -> False,
FrameStyle -> 16,
GridLines -> Automatic, ...
10
Add the option PlotMarkers -> None:
themes = "Base" /. Charting`$PlotThemes;
Grid @ Partition[ListLinePlot[points, Mesh -> 2,
PlotMarkers->None, PlotLabel -> #, PlotTheme ->#, ImageSize -> Medium]& /@ themes, 2]
We need to add this option for the three themes ("Business", "Marketing" and "Monochrome") because other themes do not use ...
1
Use Placed:
Plot[
{Sin[x], Cos[x]}, {x, -Pi, Pi},
PlotLegends -> Placed[{"first", "second"}, {Left, 0.9}]
]
Within Placed, Left indicates a position within the plot, aligned to its left margin; The 0.9 is a scaled position, at 90% height, the reference being the bottom left corner. Note that if, instead of Left, you had used $0$, the legend would be ...
2
This could be a start, using the made up functions you suggested. I am using red and green as the two colors to mix to highlight the differences (red and blue was not very visible).
ClearAll[energy, spin]
energy[x_] := Cos[x]
spin[x_] := Sin[x]
Plot[
energy[x], {x, -2 Pi, 2 Pi},
ColorFunctionScaling -> False,
ColorFunction -> (Blend[{Red, Green}...
0
Use the form Blend[{{x1, color1}, {x2, color2}, {x3, color3},...}, x] to get colori when x == xi:
blend = Blend[{{7.9, Red}, {8.15, Yellow}, {8.7, Red}}, #] &;
GraphicsGrid[Partition[
Table[Graphics[{blend[x], Rectangle[], Black, Text[Style[x, 14], {1, 1}/2]}],
{x, 7.55, 9, .05}],
10]]
1
Try setting the AxesOrigin option:
Plot[Tanh[2 (x - 2)] + 1.1, {x, 0, 4},
PlotRange -> {{0, 4}, {0, 5/2}}, AxesOrigin -> {4, 0},
AxesLabel -> {x, y}, PlotTheme -> "Classic", PlotStyle -> Thick]
2
You can use your favorite font:
Manipulate[Style["[", FontSize -> t, FontFamily -> "Al Bayan"], {t, 1, 500}]
1
I'm not certain if this produces the exact output you're looking for in all cases. If it's not quite right, let me know and hopefully either I can adjust it or someone else may come along with a better solution.
Essentially, one of the possibilities for Ticks is to use a function. In this case, #1 is the minimum and #2 is the maximum of where it would like ...
8
How about this using rectangles instead of Lines?
paren[t1_, t2_, p_, h_] := {Rectangle[{0, 0}, {t1, h}],
Rectangle[{0, 0}, {t2 + p, t2}], Rectangle[{0, h}, {t2 + p, h - t2}]}
Manipulate[
Graphics[paren[t1, t2, p, h], PlotRange -> {{0, 1}, {0, 1}}],
{{t1, .1}, 0, .3}, {{t2, .1}, 0, .3}, {{p, .2}, 0, .5}, {{h, 1}, 0, 2}
]
1
ClearAll[pwToCE]
pwToCE[f_] := ConditionalExpression @@@ f[#][[1]] &
positions = {-2, {.5, Above}, {1.5, Below}};
Plot[Evaluate@MapThread[Callout[#, #[[1]], #2] &, {pwToCE[h][x], positions}],
{x, -3, 3}, PlotStyle -> ColorData[97][1]]
0
This is a comment-with-images rather than an answer.
Something is odd here. I ran your code exactly as posted (only removing a spurious \ that was probably leftover from copy-pasting), and it returns a contour plot very quickly (in roughly one second or so):
ContourPlot[
Sort[Eigenvalues[Hfull]][[1]],
{kx, -kpi, kpi}, {ky, -kpi, kpi},
Contours ->...
1
Change Red to {Arrowheads[{{0.05, .5}}], Red} to get
7
As in my comment above, these are called 'Coons patches' https://en.wikipedia.org/wiki/Coons_patch
The following is simply adapted from the equations on that page:
c0[t_] := {t, 0, t^2}
d0[t_] := {0, t, t^2}
c1[t_] := {t, 1, 1 + t^2}
d1[t_] := {1, t, 1 + t^2}
lc[s_, t_] := (1 - t) c0[s] + t c1[s]
ld[s_, t_] := (1 - s) d0[t] + s d1[t]
b[s_, t_] :=
c0[0] (...
0
You can replace the integral in the plot with 1/2 Sqrt[\[Pi]] Erfi[t] - it will be faster and it will let you increase the sample rate.
You can increase the PlotPoints to get a better plot.
Correct me if I'm wrong but I don't think you don't need WhiteNoiseProcess here - you can just draw from a NormalDistribution directly.
σ = 1;
Plot3D[-6 + 12*Tanh[x + (...
0
You can use ParametricNDSolveValue to create a parametric function and use it inside Manipulate:
ClearAll[pndsv]
pndsv = ParametricNDSolveValue[{D[S[t], t] + α*S[t]*Inf[t] == 0,
D[Inf[t], t] + β*Inf[t] - α*S[t]*Inf[t] == 0,
D[R[t], t] - β*Inf[t] == 0,
S[0] == 0.88, Inf[0] == 0.11, R[0] == 0},
{S, Inf, R}, {t, 0, 60}, {α, β}];
Manipulate[...
3
Clear["Global`*"]
sol = n /. Solve[n (1/4 + (a - 6 n/10^3)^2) == 40 && n > 0, n, Reals];
There are three roots
Length@sol
(* 3 *)
To see the full curve you need to increase the function sampling (PlotPoints option) particularly at transitions between the solutions (MaxRecursions option)
Plot[Evaluate[sol], {a, -3, 3},
PlotStyle -> {...
4
ContourPlot[n (1/4 + (a - 6 n/10^3)^2) == 40, {a, -3, 3}, {n, 0, 170}]
does the job.
5
Add the option PlotTheme -> None to get
5
Use higher precision than 60
Ξ2[t_?NumericQ] :=
Sum[(k^2*Pi)^(-(1/4) + (I*t)/2)*((-(1/4) - (I*t)/2)*
Gamma[5/4 - (I*t)/2, (k*Pi)^2/t] + ((k*Pi)^2/t)^(5/4 - (I*t)/2)*
Exp[-((k*Pi)^2/t)]) + (k^2*Pi)^(-(1/4) - (I*t)/2)*((-(1/4) + (I*t)/2)*
Gamma[5/4 + (I*t)/2, (k*Pi)^2/t] + ((k*Pi)^2/t)^(5/4 + (I*t)/2)*
Exp[-((k*Pi)^2/t)]), {k, 1, ...
4
Clear["Global`*"]
f[β_, ξ_, M_, θ_] := ((2/β^2 - 1)
+ ((θ Exp[-β])/2 - 1/2) ξ +
Sum[((-β)^n ξ^(1 + n/2))/n! HurwitzZeta[-(n/2),
1 + 1/ξ], {n, 1, M}]);
To use high precision, make the input parameters exact values.
Plot[{
f[1/2, -4 x, 60, 1],
f[1/2, 4 x, 60, 0],
f[4/5, -4 x, 60, 1],
f[4/5, 4 x, 60, 0],
f[11/10, -4 x, 60, 1],
...
3
I'll start by making a random dataset. Here we take 2 random numbers for the first two variables then set the third such that $a+b+c=1$ to be consistent with a Ternary plot. Here $a,b,c$ correspond to carbs, fat, protein respectively. We take the 4th variable to be another independent random number which corresponds to sleep for your case. Lastly we select ...
2
Use FrameTicks instead of Ticks and add the option Frame->True.
Rescale
the in put data to run from 0 to 8.
ArrayPlot[Rescale[data, MinMax@data, {0, 8}],
ColorFunction -> "Rainbow", PlotTheme -> "Detailed", Mesh -> True,
Frame -> True, FrameTicks -> {{g4, None}, {g3, None}} ]
Add the option PlotLegends -> Range[0, 8] to get
3
Another possibility is to use RegionPlot3D[x^2 + y^2 + z^2 < 1, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}].
9
The equation for a sphere is x^2 + y^2 + z^2 == r^2
With[{r = 7.5},
ContourPlot3D[r^2 == (x^2 + y^2 + z^2),
{x, -10, 10}, {y, -10, 10}, {z, -10, 10},
AxesOrigin -> {0, 0, 0},
PlotRange -> {-10, 10},
BoxRatios -> {1, 1, 1},
AxesLabel -> {"X", "Y", "Z"},
ViewPoint -> Front]]
To use Plot3D you must solve for both solutions for z
...
2
I would recommend generating a list of Point objects encapsulated in Style directives to feed to Graphics:
newcoloredData =
Style[
Point[{#1, #2}],
{#3, #6} /. {{0, 0} -> Gray, {0, 1} -> Black, {1, 0} -> Red}
]& @@@ Flatten[data, 1];
Graphics[{coloredData}, Axes -> True]
Note also that, rather than Flattening your data all ...
0
The function given to FrameTicks (FrameTicks->fticks) is internally evaluated twice:
fticks[10^9, 10^11]: with the user plot range
fticks[Log[10^9], Log[10^11]]: with the log of the plot range
The ticks will be drawn according to the second evaluation, only if Mathematica doesn't fail during the first evaluation.
Simply tell Mathematica to avoid ...
0
An alternative approach: use GeoBubbleChart to generate the disks and use the primitives as Epilog:
bubbles = {Entity["City", {"NewYork", "NewYork", "UnitedStates"}] -> 3,
Entity["City", {"Madrid", "Madrid", "Spain"}] -> 2,
Entity["City", {"Beijing", "Beijing", "China"}] -> 5};
epilog = GeoBubbleChart[bubbles,
ColorFunction -> "...
4
The margins of the plot are calculated assuming that the Arrowheads are given in plot coordinates. This is wrong because for drawing them Mathematica takes them as a fraction of the plot size. This is known issue for years, but your code is fine, you just have to tell Mathematica to keep those margins under control by adding the option
ImagePadding -> ...
2
1. Using the options Exclusions and ExclusionsStyle
Row[ContourPlot[Sin[x y], {x, -Pi/2, Pi/2}, {y, -Pi/2, Pi/2},
ImageSize -> Medium,
Exclusions -> {Sin[x y] == #},
ExclusionsStyle -> {Red, Red}] & /@ {0, .4}]
2. Using MeshFunctions, Mesh and MeshStyle:
Row[ContourPlot[Sin[x y], {x, -Pi/2, Pi/2}, {y, -Pi/2, Pi/2},
...
2
Plot[{x, y, z}, {d, 0, 1}, Filling -> {3 -> {2}},
PlotLegends -> Placed[LineLegend @ {"Assignment by lottery", "Complete equality",
"FCFS"}, {0.35, 0.7}],
PlotStyle -> {RGBColor[0.368417, 0.506779, 0.709798],
RGBColor[0.560181, 0.691569, 0.194885],
RGBColor[0.922526, 0.385626, 0.209179]},
AxesLabel -> {F[t], Subscript[L, P][F[...
5
One could in principle use RegionPlot to do this, though it requires some finesse:
RegionPlot[(p < pAB[v] || p < pBC[v]) && p > pCD[v] && v > Va, {v, 0,
1}, {p, 0, 500000}, PlotPoints -> 100, AspectRatio -> 1/GoldenRatio,
Frame -> False, Axes -> True]
Note that I had to be a bit clever with the combination of ...
Top 50 recent answers are included
